home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / perl5000.zip / perl5000 / pp.c < prev    next >
C/C++ Source or Header  |  1994-10-17  |  64KB  |  3,479 lines
  1. /*    pp.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "It's a big house this, and very peculiar.  Always a bit more to discover,
  12.  * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. static void doencodes _((SV *sv, char *s, I32 len));
  19.  
  20. /* variations on pp_null */
  21.  
  22. PP(pp_stub)
  23. {
  24.     dSP;
  25.     if (GIMME != G_ARRAY) {
  26.     XPUSHs(&sv_undef);
  27.     }
  28.     RETURN;
  29. }
  30.  
  31. PP(pp_scalar)
  32. {
  33.     return NORMAL;
  34. }
  35.  
  36. /* Pushy stuff. */
  37.  
  38. PP(pp_padav)
  39. {
  40.     dSP; dTARGET;
  41.     if (op->op_private & OPpLVAL_INTRO)
  42.     SAVECLEARSV(curpad[op->op_targ]);
  43.     EXTEND(SP, 1);
  44.     if (op->op_flags & OPf_REF) {
  45.     PUSHs(TARG);
  46.     RETURN;
  47.     }
  48.     if (GIMME == G_ARRAY) {
  49.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  50.     EXTEND(SP, maxarg);
  51.     Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
  52.     SP += maxarg;
  53.     }
  54.     else {
  55.     SV* sv = sv_newmortal();
  56.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  57.     sv_setiv(sv, maxarg);
  58.     PUSHs(sv);
  59.     }
  60.     RETURN;
  61. }
  62.  
  63. PP(pp_padhv)
  64. {
  65.     dSP; dTARGET;
  66.     XPUSHs(TARG);
  67.     if (op->op_private & OPpLVAL_INTRO)
  68.     SAVECLEARSV(curpad[op->op_targ]);
  69.     if (op->op_flags & OPf_REF)
  70.     RETURN;
  71.     if (GIMME == G_ARRAY) { /* array wanted */
  72.     RETURNOP(do_kv(ARGS));
  73.     }
  74.     else {
  75.     SV* sv = sv_newmortal();
  76.     if (HvFILL((HV*)TARG)) {
  77.         sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
  78.         sv_setpv(sv, buf);
  79.     }
  80.     else
  81.         sv_setiv(sv, 0);
  82.     SETs(sv);
  83.     RETURN;
  84.     }
  85. }
  86.  
  87. PP(pp_padany)
  88. {
  89.     DIE("NOT IMPL LINE %d",__LINE__);
  90. }
  91.  
  92. /* Translations. */
  93.  
  94. PP(pp_rv2gv)
  95. {
  96.     dSP; dTOPss;
  97.     
  98.     if (SvROK(sv)) {
  99.       wasref:
  100.     sv = SvRV(sv);
  101.     if (SvTYPE(sv) != SVt_PVGV)
  102.         DIE("Not a GLOB reference");
  103.     }
  104.     else {
  105.     if (SvTYPE(sv) != SVt_PVGV) {
  106.         if (SvGMAGICAL(sv)) {
  107.         mg_get(sv);
  108.         if (SvROK(sv))
  109.             goto wasref;
  110.         }
  111.         if (!SvOK(sv)) {
  112.         if (op->op_flags & OPf_REF ||
  113.             op->op_private & HINT_STRICT_REFS)
  114.             DIE(no_usym, "a symbol");
  115.         RETSETUNDEF;
  116.         }
  117.         if (op->op_private & HINT_STRICT_REFS)
  118.         DIE(no_symref, "a symbol");
  119.         sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVGV);
  120.     }
  121.     }
  122.     if (op->op_private & OPpLVAL_INTRO) {
  123.     GP *ogp = GvGP(sv);
  124.  
  125.     SSCHECK(3);
  126.     SSPUSHPTR(sv);
  127.     SSPUSHPTR(ogp);
  128.     SSPUSHINT(SAVEt_GP);
  129.  
  130.     if (op->op_flags & OPf_SPECIAL) {
  131.         GvGP(sv)->gp_refcnt++;        /* will soon be assigned */
  132.         GvFLAGS(sv) |= GVf_INTRO;
  133.     }
  134.     else {
  135.         GP *gp;
  136.         Newz(602,gp, 1, GP);
  137.         GvGP(sv) = gp;
  138.         GvREFCNT(sv) = 1;
  139.         GvSV(sv) = NEWSV(72,0);
  140.         GvLINE(sv) = curcop->cop_line;
  141.         GvEGV(sv) = sv;
  142.     }
  143.     }
  144.     SETs(sv);
  145.     RETURN;
  146. }
  147.  
  148. PP(pp_sv2len)
  149. {
  150.     dSP; dTARGET;
  151.     dPOPss;
  152.     PUSHi(sv_len(sv));
  153.     RETURN;
  154. }
  155.  
  156. PP(pp_rv2sv)
  157. {
  158.     dSP; dTOPss;
  159.  
  160.     if (SvROK(sv)) {
  161.       wasref:
  162.     sv = SvRV(sv);
  163.     switch (SvTYPE(sv)) {
  164.     case SVt_PVAV:
  165.     case SVt_PVHV:
  166.     case SVt_PVCV:
  167.         DIE("Not a SCALAR reference");
  168.     }
  169.     }
  170.     else {
  171.     GV *gv = sv;
  172.     if (SvTYPE(gv) != SVt_PVGV) {
  173.         if (SvGMAGICAL(sv)) {
  174.         mg_get(sv);
  175.         if (SvROK(sv))
  176.             goto wasref;
  177.         }
  178.         if (!SvOK(sv)) {
  179.         if (op->op_flags & OPf_REF ||
  180.             op->op_private & HINT_STRICT_REFS)
  181.             DIE(no_usym, "a SCALAR");
  182.         RETSETUNDEF;
  183.         }
  184.         if (op->op_private & HINT_STRICT_REFS)
  185.         DIE(no_symref, "a SCALAR");
  186.         gv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PV);
  187.     }
  188.     sv = GvSV(gv);
  189.     }
  190.     if (op->op_flags & OPf_MOD) {
  191.     if (op->op_private & OPpLVAL_INTRO)
  192.         sv = save_scalar((GV*)TOPs);
  193.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
  194.         if (SvGMAGICAL(sv))
  195.         mg_get(sv);
  196.         if (!SvOK(sv)) {
  197.         (void)SvUPGRADE(sv, SVt_RV);
  198.         SvRV(sv) = (op->op_private & OPpDEREF_HV ?
  199.                 (SV*)newHV() : (SV*)newAV());
  200.         SvROK_on(sv);
  201.         SvSETMAGIC(sv);
  202.         }
  203.     }
  204.     }
  205.     SETs(sv);
  206.     RETURN;
  207. }
  208.  
  209. PP(pp_av2arylen)
  210. {
  211.     dSP;
  212.     AV *av = (AV*)TOPs;
  213.     SV *sv = AvARYLEN(av);
  214.     if (!sv) {
  215.     AvARYLEN(av) = sv = NEWSV(0,0);
  216.     sv_upgrade(sv, SVt_IV);
  217.     sv_magic(sv, (SV*)av, '#', Nullch, 0);
  218.     }
  219.     SETs(sv);
  220.     RETURN;
  221. }
  222.  
  223. PP(pp_pos)
  224. {
  225.     dSP; dTARGET; dPOPss;
  226.     
  227.     if (op->op_flags & OPf_MOD) {
  228.     LvTYPE(TARG) = '<';
  229.     LvTARG(TARG) = sv;
  230.     PUSHs(TARG);    /* no SvSETMAGIC */
  231.     RETURN;
  232.     }
  233.     else {
  234.     MAGIC* mg; 
  235.  
  236.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
  237.         mg = mg_find(sv, 'g');
  238.         if (mg && mg->mg_len >= 0) {
  239.         PUSHi(mg->mg_len + curcop->cop_arybase);
  240.         RETURN;
  241.         }
  242.     }
  243.     RETPUSHUNDEF;
  244.     }
  245. }
  246.  
  247. PP(pp_rv2cv)
  248. {
  249.     dSP;
  250.     GV *gv;
  251.     HV *stash;
  252.  
  253.     /* We always try to add a non-existent subroutine in case of AUTOLOAD. */
  254.     CV *cv = sv_2cv(TOPs, &stash, &gv, TRUE);
  255.  
  256.     SETs((SV*)cv);
  257.     RETURN;
  258. }
  259.  
  260. PP(pp_anoncode)
  261. {
  262.     dSP;
  263.     XPUSHs(cSVOP->op_sv);
  264.     RETURN;
  265. }
  266.  
  267. PP(pp_srefgen)
  268. {
  269.     dSP; dTOPss;
  270.     SV* rv;
  271.     rv = sv_newmortal();
  272.     sv_upgrade(rv, SVt_RV);
  273.     if (SvPADTMP(sv))
  274.     sv = newSVsv(sv);
  275.     else {
  276.     SvTEMP_off(sv);
  277.     (void)SvREFCNT_inc(sv);
  278.     }
  279.     SvRV(rv) = sv;
  280.     SvROK_on(rv);
  281.     SETs(rv);
  282.     RETURN;
  283. } 
  284.  
  285. PP(pp_refgen)
  286. {
  287.     dSP; dMARK;
  288.     SV* sv;
  289.     SV* rv;
  290.     if (GIMME != G_ARRAY) {
  291.     MARK[1] = *SP;
  292.     SP = MARK + 1;
  293.     }
  294.     while (MARK < SP) {
  295.     sv = *++MARK;
  296.     rv = sv_newmortal();
  297.     sv_upgrade(rv, SVt_RV);
  298.     if (SvPADTMP(sv))
  299.         sv = newSVsv(sv);
  300.     else {
  301.         SvTEMP_off(sv);
  302.         (void)SvREFCNT_inc(sv);
  303.     }
  304.     SvRV(rv) = sv;
  305.     SvROK_on(rv);
  306.     *MARK = rv;
  307.     }
  308.     RETURN;
  309. }
  310.  
  311. PP(pp_ref)
  312. {
  313.     dSP; dTARGET;
  314.     SV *sv;
  315.     char *pv;
  316.  
  317.     sv = POPs;
  318.     if (!sv || !SvROK(sv))
  319.     RETPUSHUNDEF;
  320.  
  321.     sv = SvRV(sv);
  322.     pv = sv_reftype(sv,TRUE);
  323.     PUSHp(pv, strlen(pv));
  324.     RETURN;
  325. }
  326.  
  327. PP(pp_bless)
  328. {
  329.     dSP;
  330.     HV *stash;
  331.  
  332.     if (MAXARG == 1)
  333.     stash = curcop->cop_stash;
  334.     else
  335.     stash = gv_stashsv(POPs, TRUE);
  336.  
  337.     (void)sv_bless(TOPs, stash);
  338.     RETURN;
  339. }
  340.  
  341. /* Pattern matching */
  342.  
  343. PP(pp_study)
  344. {
  345.     dSP; dTARGET;
  346.     register unsigned char *s;
  347.     register I32 pos;
  348.     register I32 ch;
  349.     register I32 *sfirst;
  350.     register I32 *snext;
  351.     I32 retval;
  352.     STRLEN len;
  353.  
  354.     s = (unsigned char*)(SvPV(TARG, len));
  355.     pos = len;
  356.     if (lastscream)
  357.     SvSCREAM_off(lastscream);
  358.     lastscream = TARG;
  359.     if (pos <= 0) {
  360.     retval = 0;
  361.     goto ret;
  362.     }
  363.     if (pos > maxscream) {
  364.     if (maxscream < 0) {
  365.         maxscream = pos + 80;
  366.         New(301, screamfirst, 256, I32);
  367.         New(302, screamnext, maxscream, I32);
  368.     }
  369.     else {
  370.         maxscream = pos + pos / 4;
  371.         Renew(screamnext, maxscream, I32);
  372.     }
  373.     }
  374.  
  375.     sfirst = screamfirst;
  376.     snext = screamnext;
  377.  
  378.     if (!sfirst || !snext)
  379.     DIE("do_study: out of memory");
  380.  
  381.     for (ch = 256; ch; --ch)
  382.     *sfirst++ = -1;
  383.     sfirst -= 256;
  384.  
  385.     while (--pos >= 0) {
  386.     ch = s[pos];
  387.     if (sfirst[ch] >= 0)
  388.         snext[pos] = sfirst[ch] - pos;
  389.     else
  390.         snext[pos] = -pos;
  391.     sfirst[ch] = pos;
  392.  
  393.     /* If there were any case insensitive searches, we must assume they
  394.      * all are.  This speeds up insensitive searches much more than
  395.      * it slows down sensitive ones.
  396.      */
  397.     if (sawi)
  398.         sfirst[fold[ch]] = pos;
  399.     }
  400.  
  401.     SvSCREAM_on(TARG);
  402.     retval = 1;
  403.   ret:
  404.     XPUSHs(sv_2mortal(newSViv((I32)retval)));
  405.     RETURN;
  406. }
  407.  
  408. PP(pp_trans)
  409. {
  410.     dSP; dTARG;
  411.     SV *sv;
  412.  
  413.     if (op->op_flags & OPf_STACKED)
  414.     sv = POPs;
  415.     else {
  416.     sv = GvSV(defgv);
  417.     EXTEND(SP,1);
  418.     }
  419.     TARG = NEWSV(27,0);
  420.     PUSHi(do_trans(sv, op));
  421.     RETURN;
  422. }
  423.  
  424. /* Lvalue operators. */
  425.  
  426. PP(pp_schop)
  427. {
  428.     dSP; dTARGET;
  429.     do_chop(TARG, TOPs);
  430.     SETTARG;
  431.     RETURN;
  432. }
  433.  
  434. PP(pp_chop)
  435. {
  436.     dSP; dMARK; dTARGET;
  437.     while (SP > MARK)
  438.     do_chop(TARG, POPs);
  439.     PUSHTARG;
  440.     RETURN;
  441. }
  442.  
  443. PP(pp_schomp)
  444. {
  445.     dSP; dTARGET;
  446.     SETi(do_chomp(TOPs));
  447.     RETURN;
  448. }
  449.  
  450. PP(pp_chomp)
  451. {
  452.     dSP; dMARK; dTARGET;
  453.     register I32 count = 0;
  454.     
  455.     while (SP > MARK)
  456.     count += do_chomp(POPs);
  457.     PUSHi(count);
  458.     RETURN;
  459. }
  460.  
  461. PP(pp_defined)
  462. {
  463.     dSP;
  464.     register SV* sv;
  465.  
  466.     sv = POPs;
  467.     if (!sv || !SvANY(sv))
  468.     RETPUSHNO;
  469.     switch (SvTYPE(sv)) {
  470.     case SVt_PVAV:
  471.     if (AvMAX(sv) >= 0)
  472.         RETPUSHYES;
  473.     break;
  474.     case SVt_PVHV:
  475.     if (HvARRAY(sv))
  476.         RETPUSHYES;
  477.     break;
  478.     case SVt_PVCV:
  479.     if (CvROOT(sv) || CvXSUB(sv))
  480.         RETPUSHYES;
  481.     break;
  482.     default:
  483.     if (SvGMAGICAL(sv))
  484.         mg_get(sv);
  485.     if (SvOK(sv))
  486.         RETPUSHYES;
  487.     }
  488.     RETPUSHNO;
  489. }
  490.  
  491. PP(pp_undef)
  492. {
  493.     dSP;
  494.     SV *sv;
  495.  
  496.     if (!op->op_private)
  497.     RETPUSHUNDEF;
  498.  
  499.     sv = POPs;
  500.     if (!sv)
  501.     RETPUSHUNDEF;
  502.  
  503.     if (SvTHINKFIRST(sv)) {
  504.     if (SvREADONLY(sv))
  505.         RETPUSHUNDEF;
  506.     if (SvROK(sv))
  507.         sv_unref(sv);
  508.     }
  509.  
  510.     switch (SvTYPE(sv)) {
  511.     case SVt_NULL:
  512.     break;
  513.     case SVt_PVAV:
  514.     av_undef((AV*)sv);
  515.     break;
  516.     case SVt_PVHV:
  517.     hv_undef((HV*)sv);
  518.     break;
  519.     case SVt_PVCV:
  520.     cv_undef((CV*)sv);
  521.     sub_generation++;
  522.     break;
  523.     default:
  524.     if (sv != GvSV(defgv)) {
  525.         if (SvPOK(sv) && SvLEN(sv)) {
  526.         (void)SvOOK_off(sv);
  527.         Safefree(SvPVX(sv));
  528.         SvPV_set(sv, Nullch);
  529.         SvLEN_set(sv, 0);
  530.         }
  531.         (void)SvOK_off(sv);
  532.         SvSETMAGIC(sv);
  533.     }
  534.     }
  535.  
  536.     RETPUSHUNDEF;
  537. }
  538.  
  539. PP(pp_predec)
  540. {
  541.     dSP;
  542.     sv_dec(TOPs);
  543.     SvSETMAGIC(TOPs);
  544.     return NORMAL;
  545. }
  546.  
  547. PP(pp_postinc)
  548. {
  549.     dSP; dTARGET;
  550.     sv_setsv(TARG, TOPs);
  551.     sv_inc(TOPs);
  552.     SvSETMAGIC(TOPs);
  553.     if (!SvOK(TARG))
  554.     sv_setiv(TARG, 0);
  555.     SETs(TARG);
  556.     return NORMAL;
  557. }
  558.  
  559. PP(pp_postdec)
  560. {
  561.     dSP; dTARGET;
  562.     sv_setsv(TARG, TOPs);
  563.     sv_dec(TOPs);
  564.     SvSETMAGIC(TOPs);
  565.     SETs(TARG);
  566.     return NORMAL;
  567. }
  568.  
  569. /* Ordinary operators. */
  570.  
  571. PP(pp_pow)
  572. {
  573.     dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); 
  574.     {
  575.       dPOPTOPnnrl;
  576.       SETn( pow( left, right) );
  577.       RETURN;
  578.     }
  579. }
  580.  
  581. PP(pp_multiply)
  582. {
  583.     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
  584.     {
  585.       dPOPTOPnnrl;
  586.       SETn( left * right );
  587.       RETURN;
  588.     }
  589. }
  590.  
  591. PP(pp_divide)
  592. {
  593.     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
  594.     {
  595.       dPOPnv;
  596.       if (value == 0.0)
  597.     DIE("Illegal division by zero");
  598. #ifdef SLOPPYDIVIDE
  599.       /* insure that 20./5. == 4. */
  600.       {
  601.     double x;
  602.     I32    k;
  603.     x =  POPn;
  604.     if ((double)I_32(x)     == x &&
  605.         (double)I_32(value) == value &&
  606.         (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
  607.         value = k;
  608.     } else {
  609.         value = x/value;
  610.     }
  611.       }
  612. #else
  613.       value = POPn / value;
  614. #endif
  615.       PUSHn( value );
  616.       RETURN;
  617.     }
  618. }
  619.  
  620. PP(pp_modulo)
  621. {
  622.     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
  623.     {
  624.       register unsigned long tmpulong;
  625.       register long tmplong;
  626.       I32 value;
  627.  
  628.       tmpulong = (unsigned long) POPn;
  629.       if (tmpulong == 0L)
  630.     DIE("Illegal modulus zero");
  631.       value = TOPn;
  632.       if (value >= 0.0)
  633.     value = (I32)(((unsigned long)value) % tmpulong);
  634.       else {
  635.     tmplong = (long)value;
  636.     value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
  637.       }
  638.       SETi(value);
  639.       RETURN;
  640.     }
  641. }
  642.  
  643. PP(pp_repeat)
  644. {
  645.     dSP; dATARGET;
  646.     register I32 count = POPi;
  647.     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
  648.     dMARK;
  649.     I32 items = SP - MARK;
  650.     I32 max;
  651.  
  652.     max = items * count;
  653.     MEXTEND(MARK, max);
  654.     if (count > 1) {
  655.         while (SP > MARK) {
  656.         if (*SP)
  657.             SvTEMP_off((*SP));
  658.         SP--;
  659.         }
  660.         MARK++;
  661.         repeatcpy((char*)(MARK + items), (char*)MARK,
  662.         items * sizeof(SV*), count - 1);
  663.         SP += max;
  664.     }
  665.     else if (count <= 0)
  666.         SP -= items;
  667.     }
  668.     else {    /* Note: mark already snarfed by pp_list */
  669.     SV *tmpstr;
  670.     STRLEN len;
  671.  
  672.     tmpstr = POPs;
  673.     if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
  674.         if (SvREADONLY(tmpstr) && curcop != &compiling)
  675.         DIE("Can't x= to readonly value");
  676.         if (SvROK(tmpstr))
  677.         sv_unref(tmpstr);
  678.     }
  679.     SvSetSV(TARG, tmpstr);
  680.     SvPV_force(TARG, len);
  681.     if (count >= 1) {
  682.         SvGROW(TARG, (count * len) + 1);
  683.         if (count > 1)
  684.         repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
  685.         SvCUR(TARG) *= count;
  686.         *SvEND(TARG) = '\0';
  687.         (void)SvPOK_only(TARG);
  688.     }
  689.     else
  690.         sv_setsv(TARG, &sv_no);
  691.     PUSHTARG;
  692.     }
  693.     RETURN;
  694. }
  695.  
  696. PP(pp_subtract)
  697. {
  698.     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
  699.     {
  700.       dPOPTOPnnrl;
  701.       SETn( left - right );
  702.       RETURN;
  703.     }
  704. }
  705.  
  706. PP(pp_left_shift)
  707. {
  708.     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); 
  709.     {
  710.       dPOPTOPiirl;
  711.       SETi( left << right );
  712.       RETURN;
  713.     }
  714. }
  715.  
  716. PP(pp_right_shift)
  717. {
  718.     dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); 
  719.     {
  720.       dPOPTOPiirl;
  721.       SETi( left >> right );
  722.       RETURN;
  723.     }
  724. }
  725.  
  726. PP(pp_lt)
  727. {
  728.     dSP; tryAMAGICbinSET(lt,0); 
  729.     {
  730.       dPOPnv;
  731.       SETs((TOPn < value) ? &sv_yes : &sv_no);
  732.       RETURN;
  733.     }
  734. }
  735.  
  736. PP(pp_gt)
  737. {
  738.     dSP; tryAMAGICbinSET(gt,0); 
  739.     {
  740.       dPOPnv;
  741.       SETs((TOPn > value) ? &sv_yes : &sv_no);
  742.       RETURN;
  743.     }
  744. }
  745.  
  746. PP(pp_le)
  747. {
  748.     dSP; tryAMAGICbinSET(le,0); 
  749.     {
  750.       dPOPnv;
  751.       SETs((TOPn <= value) ? &sv_yes : &sv_no);
  752.       RETURN;
  753.     }
  754. }
  755.  
  756. PP(pp_ge)
  757. {
  758.     dSP; tryAMAGICbinSET(ge,0); 
  759.     {
  760.       dPOPnv;
  761.       SETs((TOPn >= value) ? &sv_yes : &sv_no);
  762.       RETURN;
  763.     }
  764. }
  765.  
  766. PP(pp_ne)
  767. {
  768.     dSP; tryAMAGICbinSET(ne,0); 
  769.     {
  770.       dPOPnv;
  771.       SETs((TOPn != value) ? &sv_yes : &sv_no);
  772.       RETURN;
  773.     }
  774. }
  775.  
  776. PP(pp_ncmp)
  777. {
  778.     dSP; dTARGET; tryAMAGICbin(ncmp,0); 
  779.     {
  780.       dPOPTOPnnrl;
  781.       I32 value;
  782.  
  783.       if (left > right)
  784.     value = 1;
  785.       else if (left < right)
  786.     value = -1;
  787.       else
  788.     value = 0;
  789.       SETi(value);
  790.       RETURN;
  791.     }
  792. }
  793.  
  794. PP(pp_slt)
  795. {
  796.     dSP; tryAMAGICbinSET(slt,0); 
  797.     {
  798.       dPOPTOPssrl;
  799.       SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no );
  800.       RETURN;
  801.     }
  802. }
  803.  
  804. PP(pp_sgt)
  805. {
  806.     dSP; tryAMAGICbinSET(sgt,0); 
  807.     {
  808.       dPOPTOPssrl;
  809.       SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no );
  810.       RETURN;
  811.     }
  812. }
  813.  
  814. PP(pp_sle)
  815. {
  816.     dSP; tryAMAGICbinSET(sle,0); 
  817.     {
  818.       dPOPTOPssrl;
  819.       SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no );
  820.       RETURN;
  821.     }
  822. }
  823.  
  824. PP(pp_sge)
  825. {
  826.     dSP; tryAMAGICbinSET(sge,0); 
  827.     {
  828.       dPOPTOPssrl;
  829.       SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no );
  830.       RETURN;
  831.     }
  832. }
  833.  
  834. PP(pp_sne)
  835. {
  836.     dSP; tryAMAGICbinSET(sne,0); 
  837.     {
  838.       dPOPTOPssrl;
  839.       SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
  840.       RETURN;
  841.     }
  842. }
  843.  
  844. PP(pp_scmp)
  845. {
  846.     dSP; dTARGET;  tryAMAGICbin(scmp,0);
  847.     {
  848.       dPOPTOPssrl;
  849.       SETi( sv_cmp(left, right) );
  850.       RETURN;
  851.     }
  852. }
  853.  
  854. PP(pp_bit_and) {
  855.     dSP; dATARGET; tryAMAGICbin(band,opASSIGN); 
  856.     {
  857.       dPOPTOPssrl;
  858.       if (SvNIOK(left) || SvNIOK(right)) {
  859.     unsigned long value = U_L(SvNV(left));
  860.     value = value & U_L(SvNV(right));
  861.     SETn((double)value);
  862.       }
  863.       else {
  864.     do_vop(op->op_type, TARG, left, right);
  865.     SETTARG;
  866.       }
  867.       RETURN;
  868.     }
  869. }
  870.  
  871. PP(pp_bit_xor)
  872. {
  873.     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); 
  874.     {
  875.       dPOPTOPssrl;
  876.       if (SvNIOK(left) || SvNIOK(right)) {
  877.     unsigned long value = U_L(SvNV(left));
  878.     value = value ^ U_L(SvNV(right));
  879.     SETn((double)value);
  880.       }
  881.       else {
  882.     do_vop(op->op_type, TARG, left, right);
  883.     SETTARG;
  884.       }
  885.       RETURN;
  886.     }
  887. }
  888.  
  889. PP(pp_bit_or)
  890. {
  891.     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); 
  892.     {
  893.       dPOPTOPssrl;
  894.       if (SvNIOK(left) || SvNIOK(right)) {
  895.     unsigned long value = U_L(SvNV(left));
  896.     value = value | U_L(SvNV(right));
  897.     SETn((double)value);
  898.       }
  899.       else {
  900.     do_vop(op->op_type, TARG, left, right);
  901.     SETTARG;
  902.       }
  903.       RETURN;
  904.     }
  905. }
  906.  
  907. PP(pp_negate)
  908. {
  909.     dSP; dTARGET; tryAMAGICun(neg);
  910.     {
  911.     dTOPss;
  912.     if (SvNIOK(sv))
  913.         SETn(-SvNV(sv));
  914.     else if (SvPOK(sv)) {
  915.         STRLEN len;
  916.         char *s = SvPV(sv, len);
  917.         if (isALPHA(*s) || *s == '_') {
  918.         sv_setpvn(TARG, "-", 1);
  919.         sv_catsv(TARG, sv);
  920.         }
  921.         else if (*s == '+' || *s == '-') {
  922.         sv_setsv(TARG, sv);
  923.         *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
  924.         }
  925.         else
  926.         sv_setnv(TARG, -SvNV(sv));
  927.         SETTARG;
  928.     }
  929.     }
  930.     RETURN;
  931. }
  932.  
  933. PP(pp_not)
  934. {
  935. #ifdef OVERLOAD
  936.     dSP; tryAMAGICunSET(not);
  937. #endif /* OVERLOAD */
  938.     *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
  939.     return NORMAL;
  940. }
  941.  
  942. PP(pp_complement)
  943. {
  944.     dSP; dTARGET; tryAMAGICun(compl); 
  945.     {
  946.       dTOPss;
  947.       register I32 anum;
  948.  
  949.       if (SvNIOK(sv)) {
  950.     SETi(  ~SvIV(sv) );
  951.       }
  952.       else {
  953.     register char *tmps;
  954.     register long *tmpl;
  955.     STRLEN len;
  956.  
  957.     SvSetSV(TARG, sv);
  958.     tmps = SvPV_force(TARG, len);
  959.     anum = len;
  960. #ifdef LIBERAL
  961.     for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
  962.         *tmps = ~*tmps;
  963.     tmpl = (long*)tmps;
  964.     for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
  965.         *tmpl = ~*tmpl;
  966.     tmps = (char*)tmpl;
  967. #endif
  968.     for ( ; anum > 0; anum--, tmps++)
  969.         *tmps = ~*tmps;
  970.  
  971.     SETs(TARG);
  972.       }
  973.       RETURN;
  974.     }
  975. }
  976.  
  977. /* integer versions of some of the above */
  978.  
  979. PP(pp_i_preinc)
  980. {
  981. #ifndef OVERLOAD
  982.     dSP; dTOPiv;
  983.     sv_setiv(TOPs, value + 1);
  984.     SvSETMAGIC(TOPs);
  985. #else
  986.     dSP;
  987.     if (SvAMAGIC(TOPs) ) {
  988.       sv_inc(TOPs);
  989.     } else {
  990.       dTOPiv;
  991.       sv_setiv(TOPs, value + 1);
  992.       SvSETMAGIC(TOPs);
  993.     }
  994. #endif /* OVERLOAD */
  995.     return NORMAL;
  996. }
  997.  
  998. PP(pp_i_predec)
  999. {
  1000. #ifndef OVERLOAD
  1001.     dSP; dTOPiv;
  1002.     sv_setiv(TOPs, value - 1);
  1003.     SvSETMAGIC(TOPs);
  1004. #else
  1005.     dSP;
  1006.     if (SvAMAGIC(TOPs)) {
  1007.       sv_dec(TOPs);
  1008.     } else {
  1009.       dTOPiv;
  1010.       sv_setiv(TOPs, value - 1);
  1011.       SvSETMAGIC(TOPs);
  1012.     }
  1013. #endif /* OVERLOAD */
  1014.     return NORMAL;
  1015. }
  1016.  
  1017. PP(pp_i_postinc)
  1018. {
  1019.     dSP; dTARGET;
  1020.     sv_setsv(TARG, TOPs);
  1021. #ifndef OVERLOAD
  1022.     sv_setiv(TOPs, SvIV(TOPs) + 1);
  1023.     SvSETMAGIC(TOPs);
  1024. #else
  1025.     if (SvAMAGIC(TOPs) ) {
  1026.       sv_inc(TOPs);
  1027.     } else {
  1028.       sv_setiv(TOPs, SvIV(TOPs) + 1);
  1029.       SvSETMAGIC(TOPs);
  1030.     }
  1031. #endif /* OVERLOAD */
  1032.     if (!SvOK(TARG))
  1033.     sv_setiv(TARG, 0);
  1034.     SETs(TARG);
  1035.     return NORMAL;
  1036. }
  1037.  
  1038. PP(pp_i_postdec)
  1039. {
  1040.     dSP; dTARGET;
  1041.     sv_setsv(TARG, TOPs);
  1042. #ifndef OVERLOAD
  1043.     sv_setiv(TOPs, SvIV(TOPs) - 1);
  1044.     SvSETMAGIC(TOPs);
  1045. #else
  1046.     if (SvAMAGIC(TOPs) ) {
  1047.       sv_dec(TOPs);
  1048.     } else {
  1049.       sv_setiv(TOPs, SvIV(TOPs) - 1);
  1050.       SvSETMAGIC(TOPs);
  1051.     }
  1052. #endif /* OVERLOAD */
  1053.     SETs(TARG);
  1054.     return NORMAL;
  1055. }
  1056.  
  1057. PP(pp_i_multiply)
  1058. {
  1059.     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
  1060.     {
  1061.       dPOPTOPiirl;
  1062.       SETi( left * right );
  1063.       RETURN;
  1064.     }
  1065. }
  1066.  
  1067. PP(pp_i_divide)
  1068. {
  1069.     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
  1070.     {
  1071.       dPOPiv;
  1072.       if (value == 0)
  1073.     DIE("Illegal division by zero");
  1074.       value = POPi / value;
  1075.       PUSHi( value );
  1076.       RETURN;
  1077.     }
  1078. }
  1079.  
  1080. PP(pp_i_modulo)
  1081. {
  1082.     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); 
  1083.     {
  1084.       dPOPTOPiirl;
  1085.       SETi( left % right );
  1086.       RETURN;
  1087.     }
  1088. }
  1089.  
  1090. PP(pp_i_add)
  1091. {
  1092.     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
  1093.     {
  1094.       dPOPTOPiirl;
  1095.       SETi( left + right );
  1096.       RETURN;
  1097.     }
  1098. }
  1099.  
  1100. PP(pp_i_subtract)
  1101. {
  1102.     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
  1103.     {
  1104.       dPOPTOPiirl;
  1105.       SETi( left - right );
  1106.       RETURN;
  1107.     }
  1108. }
  1109.  
  1110. PP(pp_i_lt)
  1111. {
  1112.     dSP; tryAMAGICbinSET(lt,0); 
  1113.     {
  1114.       dPOPTOPiirl;
  1115.       SETs((left < right) ? &sv_yes : &sv_no);
  1116.       RETURN;
  1117.     }
  1118. }
  1119.  
  1120. PP(pp_i_gt)
  1121. {
  1122.     dSP; tryAMAGICbinSET(gt,0); 
  1123.     {
  1124.       dPOPTOPiirl;
  1125.       SETs((left > right) ? &sv_yes : &sv_no);
  1126.       RETURN;
  1127.     }
  1128. }
  1129.  
  1130. PP(pp_i_le)
  1131. {
  1132.     dSP; tryAMAGICbinSET(le,0); 
  1133.     {
  1134.       dPOPTOPiirl;
  1135.       SETs((left <= right) ? &sv_yes : &sv_no);
  1136.       RETURN;
  1137.     }
  1138. }
  1139.  
  1140. PP(pp_i_ge)
  1141. {
  1142.     dSP; tryAMAGICbinSET(ge,0); 
  1143.     {
  1144.       dPOPTOPiirl;
  1145.       SETs((left >= right) ? &sv_yes : &sv_no);
  1146.       RETURN;
  1147.     }
  1148. }
  1149.  
  1150. PP(pp_i_eq)
  1151. {
  1152.     dSP; tryAMAGICbinSET(eq,0); 
  1153.     {
  1154.       dPOPTOPiirl;
  1155.       SETs((left == right) ? &sv_yes : &sv_no);
  1156.       RETURN;
  1157.     }
  1158. }
  1159.  
  1160. PP(pp_i_ne)
  1161. {
  1162.     dSP; tryAMAGICbinSET(ne,0); 
  1163.     {
  1164.       dPOPTOPiirl;
  1165.       SETs((left != right) ? &sv_yes : &sv_no);
  1166.       RETURN;
  1167.     }
  1168. }
  1169.  
  1170. PP(pp_i_ncmp)
  1171. {
  1172.     dSP; dTARGET; tryAMAGICbin(ncmp,0); 
  1173.     {
  1174.       dPOPTOPiirl;
  1175.       I32 value;
  1176.  
  1177.       if (left > right)
  1178.     value = 1;
  1179.       else if (left < right)
  1180.     value = -1;
  1181.       else
  1182.     value = 0;
  1183.       SETi(value);
  1184.       RETURN;
  1185.     }
  1186. }
  1187.  
  1188. PP(pp_i_negate)
  1189. {
  1190.     dSP; dTARGET; tryAMAGICun(neg);
  1191.     SETi(-TOPi);
  1192.     RETURN;
  1193. }
  1194.  
  1195. /* High falutin' math. */
  1196.  
  1197. PP(pp_atan2)
  1198. {
  1199.     dSP; dTARGET; tryAMAGICbin(atan2,0); 
  1200.     {
  1201.       dPOPTOPnnrl;
  1202.       SETn(atan2(left, right));
  1203.       RETURN;
  1204.     }
  1205. }
  1206.  
  1207. PP(pp_sin)
  1208. {
  1209.     dSP; dTARGET; tryAMAGICun(sin);
  1210.     {
  1211.       double value;
  1212.       value = POPn;
  1213.       value = sin(value);
  1214.       XPUSHn(value);
  1215.       RETURN;
  1216.     }
  1217. }
  1218.  
  1219. PP(pp_cos)
  1220. {
  1221.     dSP; dTARGET; tryAMAGICun(cos);
  1222.     {
  1223.       double value;
  1224.       value = POPn;
  1225.       value = cos(value);
  1226.       XPUSHn(value);
  1227.       RETURN;
  1228.     }
  1229. }
  1230.  
  1231. PP(pp_rand)
  1232. {
  1233.     dSP; dTARGET;
  1234.     double value;
  1235.     if (MAXARG < 1)
  1236.     value = 1.0;
  1237.     else
  1238.     value = POPn;
  1239.     if (value == 0.0)
  1240.     value = 1.0;
  1241. #if RANDBITS == 31
  1242.     value = rand() * value / 2147483648.0;
  1243. #else
  1244. #if RANDBITS == 16
  1245.     value = rand() * value / 65536.0;
  1246. #else
  1247. #if RANDBITS == 15
  1248.     value = rand() * value / 32768.0;
  1249. #else
  1250.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1251. #endif
  1252. #endif
  1253. #endif
  1254.     XPUSHn(value);
  1255.     RETURN;
  1256. }
  1257.  
  1258. PP(pp_srand)
  1259. {
  1260.     dSP;
  1261.     I32 anum;
  1262.     Time_t when;
  1263.  
  1264.     if (MAXARG < 1) {
  1265.     (void)time(&when);
  1266.     anum = when;
  1267.     }
  1268.     else
  1269.     anum = POPi;
  1270.     (void)srand(anum);
  1271.     EXTEND(SP, 1);
  1272.     RETPUSHYES;
  1273. }
  1274.  
  1275. PP(pp_exp)
  1276. {
  1277.     dSP; dTARGET; tryAMAGICun(exp);
  1278.     {
  1279.       double value;
  1280.       value = POPn;
  1281.       value = exp(value);
  1282.       XPUSHn(value);
  1283.       RETURN;
  1284.     }
  1285. }
  1286.  
  1287. PP(pp_log)
  1288. {
  1289.     dSP; dTARGET; tryAMAGICun(log);
  1290.     {
  1291.       double value;
  1292.       value = POPn;
  1293.       if (value <= 0.0)
  1294.     DIE("Can't take log of %g", value);
  1295.       value = log(value);
  1296.       XPUSHn(value);
  1297.       RETURN;
  1298.     }
  1299. }
  1300.  
  1301. PP(pp_sqrt)
  1302. {
  1303.     dSP; dTARGET; tryAMAGICun(sqrt);
  1304.     {
  1305.       double value;
  1306.       value = POPn;
  1307.       if (value < 0.0)
  1308.     DIE("Can't take sqrt of %g", value);
  1309.       value = sqrt(value);
  1310.       XPUSHn(value);
  1311.       RETURN;
  1312.     }
  1313. }
  1314.  
  1315. PP(pp_int)
  1316. {
  1317.     dSP; dTARGET;
  1318.     double value;
  1319.     value = POPn;
  1320.     if (value >= 0.0)
  1321.     (void)modf(value, &value);
  1322.     else {
  1323.     (void)modf(-value, &value);
  1324.     value = -value;
  1325.     }
  1326.     XPUSHn(value);
  1327.     RETURN;
  1328. }
  1329.  
  1330. PP(pp_abs)
  1331. {
  1332.     dSP; dTARGET; tryAMAGICun(abs);
  1333.     {
  1334.       double value;
  1335.       value = POPn;
  1336.  
  1337.       if (value < 0.0)
  1338.     value = -value;
  1339.  
  1340.       XPUSHn(value);
  1341.       RETURN;
  1342.     }
  1343. }
  1344.  
  1345. PP(pp_hex)
  1346. {
  1347.     dSP; dTARGET;
  1348.     char *tmps;
  1349.     I32 argtype;
  1350.  
  1351.     tmps = POPp;
  1352.     XPUSHi( scan_hex(tmps, 99, &argtype) );
  1353.     RETURN;
  1354. }
  1355.  
  1356. PP(pp_oct)
  1357. {
  1358.     dSP; dTARGET;
  1359.     I32 value;
  1360.     I32 argtype;
  1361.     char *tmps;
  1362.  
  1363.     tmps = POPp;
  1364.     while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
  1365.     tmps++;
  1366.     if (*tmps == 'x')
  1367.     value = (I32)scan_hex(++tmps, 99, &argtype);
  1368.     else
  1369.     value = (I32)scan_oct(tmps, 99, &argtype);
  1370.     XPUSHi(value);
  1371.     RETURN;
  1372. }
  1373.  
  1374. /* String stuff. */
  1375.  
  1376. PP(pp_length)
  1377. {
  1378.     dSP; dTARGET;
  1379.     SETi( sv_len(TOPs) );
  1380.     RETURN;
  1381. }
  1382.  
  1383. PP(pp_substr)
  1384. {
  1385.     dSP; dTARGET;
  1386.     SV *sv;
  1387.     I32 len;
  1388.     STRLEN curlen;
  1389.     I32 pos;
  1390.     I32 rem;
  1391.     I32 lvalue = op->op_flags & OPf_MOD;
  1392.     char *tmps;
  1393.     I32 arybase = curcop->cop_arybase;
  1394.  
  1395.     if (MAXARG > 2)
  1396.     len = POPi;
  1397.     pos = POPi - arybase;
  1398.     sv = POPs;
  1399.     tmps = SvPV(sv, curlen);
  1400.     if (pos < 0)
  1401.     pos += curlen + arybase;
  1402.     if (pos < 0 || pos > curlen) {
  1403.     if (dowarn || lvalue)
  1404.         warn("substr outside of string");
  1405.     RETPUSHUNDEF;
  1406.     }
  1407.     else {
  1408.     if (MAXARG < 3)
  1409.         len = curlen;
  1410.     else if (len < 0) {
  1411.         len += curlen;
  1412.         if (len < 0)
  1413.         len = 0;
  1414.     }
  1415.     tmps += pos;
  1416.     rem = curlen - pos;    /* rem=how many bytes left*/
  1417.     if (rem > len)
  1418.         rem = len;
  1419.     sv_setpvn(TARG, tmps, rem);
  1420.     if (lvalue) {            /* it's an lvalue! */
  1421.         if (SvTYPE(TARG) < SVt_PVLV) {
  1422.         sv_upgrade(TARG, SVt_PVLV);
  1423.         sv_magic(TARG, Nullsv, 'x', Nullch, 0);
  1424.         }
  1425.  
  1426.         LvTYPE(TARG) = 's';
  1427.         LvTARG(TARG) = sv;
  1428.         LvTARGOFF(TARG) = pos;
  1429.         LvTARGLEN(TARG) = rem; 
  1430.     }
  1431.     }
  1432.     PUSHs(TARG);        /* avoid SvSETMAGIC here */
  1433.     RETURN;
  1434. }
  1435.  
  1436. PP(pp_vec)
  1437. {
  1438.     dSP; dTARGET;
  1439.     register I32 size = POPi;
  1440.     register I32 offset = POPi;
  1441.     register SV *src = POPs;
  1442.     I32 lvalue = op->op_flags & OPf_MOD;
  1443.     STRLEN srclen;
  1444.     unsigned char *s = (unsigned char*)SvPV(src, srclen);
  1445.     unsigned long retnum;
  1446.     I32 len;
  1447.  
  1448.     offset *= size;        /* turn into bit offset */
  1449.     len = (offset + size + 7) / 8;
  1450.     if (offset < 0 || size < 1)
  1451.     retnum = 0;
  1452.     else {
  1453.     if (lvalue) {                      /* it's an lvalue! */
  1454.         if (SvTYPE(TARG) < SVt_PVLV) {
  1455.         sv_upgrade(TARG, SVt_PVLV);
  1456.         sv_magic(TARG, Nullsv, 'v', Nullch, 0);
  1457.         }
  1458.  
  1459.         LvTYPE(TARG) = 'v';
  1460.         LvTARG(TARG) = src;
  1461.         LvTARGOFF(TARG) = offset; 
  1462.         LvTARGLEN(TARG) = size; 
  1463.     }
  1464.     if (len > srclen) {
  1465.         if (size <= 8)
  1466.         retnum = 0;
  1467.         else {
  1468.         offset >>= 3;
  1469.         if (size == 16)
  1470.             retnum = (unsigned long) s[offset] << 8;
  1471.         else if (size == 32) {
  1472.             if (offset < len) {
  1473.             if (offset + 1 < len)
  1474.                 retnum = ((unsigned long) s[offset] << 24) +
  1475.                 ((unsigned long) s[offset + 1] << 16) +
  1476.                 (s[offset + 2] << 8);
  1477.             else
  1478.                 retnum = ((unsigned long) s[offset] << 24) +
  1479.                 ((unsigned long) s[offset + 1] << 16);
  1480.             }
  1481.             else
  1482.             retnum = (unsigned long) s[offset] << 24;
  1483.         }
  1484.         }
  1485.     }
  1486.     else if (size < 8)
  1487.         retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
  1488.     else {
  1489.         offset >>= 3;
  1490.         if (size == 8)
  1491.         retnum = s[offset];
  1492.         else if (size == 16)
  1493.         retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
  1494.         else if (size == 32)
  1495.         retnum = ((unsigned long) s[offset] << 24) +
  1496.             ((unsigned long) s[offset + 1] << 16) +
  1497.             (s[offset + 2] << 8) + s[offset+3];
  1498.     }
  1499.     }
  1500.  
  1501.     sv_setiv(TARG, (I32)retnum);
  1502.     PUSHs(TARG);
  1503.     RETURN;
  1504. }
  1505.  
  1506. PP(pp_index)
  1507. {
  1508.     dSP; dTARGET;
  1509.     SV *big;
  1510.     SV *little;
  1511.     I32 offset;
  1512.     I32 retval;
  1513.     char *tmps;
  1514.     char *tmps2;
  1515.     STRLEN biglen;
  1516.     I32 arybase = curcop->cop_arybase;
  1517.  
  1518.     if (MAXARG < 3)
  1519.     offset = 0;
  1520.     else
  1521.     offset = POPi - arybase;
  1522.     little = POPs;
  1523.     big = POPs;
  1524.     tmps = SvPV(big, biglen);
  1525.     if (offset < 0)
  1526.     offset = 0;
  1527.     else if (offset > biglen)
  1528.     offset = biglen;
  1529.     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
  1530.       (unsigned char*)tmps + biglen, little)))
  1531.     retval = -1 + arybase;
  1532.     else
  1533.     retval = tmps2 - tmps + arybase;
  1534.     PUSHi(retval);
  1535.     RETURN;
  1536. }
  1537.  
  1538. PP(pp_rindex)
  1539. {
  1540.     dSP; dTARGET;
  1541.     SV *big;
  1542.     SV *little;
  1543.     STRLEN blen;
  1544.     STRLEN llen;
  1545.     SV *offstr;
  1546.     I32 offset;
  1547.     I32 retval;
  1548.     char *tmps;
  1549.     char *tmps2;
  1550.     I32 arybase = curcop->cop_arybase;
  1551.  
  1552.     if (MAXARG >= 3)
  1553.     offstr = POPs;
  1554.     little = POPs;
  1555.     big = POPs;
  1556.     tmps2 = SvPV(little, llen);
  1557.     tmps = SvPV(big, blen);
  1558.     if (MAXARG < 3)
  1559.     offset = blen;
  1560.     else
  1561.     offset = SvIV(offstr) - arybase + llen;
  1562.     if (offset < 0)
  1563.     offset = 0;
  1564.     else if (offset > blen)
  1565.     offset = blen;
  1566.     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
  1567.               tmps2, tmps2 + llen)))
  1568.     retval = -1 + arybase;
  1569.     else
  1570.     retval = tmps2 - tmps + arybase;
  1571.     PUSHi(retval);
  1572.     RETURN;
  1573. }
  1574.  
  1575. PP(pp_sprintf)
  1576. {
  1577.     dSP; dMARK; dORIGMARK; dTARGET;
  1578.     do_sprintf(TARG, SP-MARK, MARK+1);
  1579.     SP = ORIGMARK;
  1580.     PUSHTARG;
  1581.     RETURN;
  1582. }
  1583.  
  1584. PP(pp_ord)
  1585. {
  1586.     dSP; dTARGET;
  1587.     I32 value;
  1588.     char *tmps;
  1589.  
  1590. #ifndef I286
  1591.     tmps = POPp;
  1592.     value = (I32) (*tmps & 255);
  1593. #else
  1594.     I32 anum;
  1595.     tmps = POPp;
  1596.     anum = (I32) *tmps;
  1597.     value = (I32) (anum & 255);
  1598. #endif
  1599.     XPUSHi(value);
  1600.     RETURN;
  1601. }
  1602.  
  1603. PP(pp_chr)
  1604. {
  1605.     dSP; dTARGET;
  1606.     char *tmps;
  1607.  
  1608.     if (!SvPOK(TARG)) {
  1609.     (void)SvUPGRADE(TARG,SVt_PV);
  1610.     SvGROW(TARG,1);
  1611.     }
  1612.     SvCUR_set(TARG, 1);
  1613.     tmps = SvPVX(TARG);
  1614.     *tmps = POPi;
  1615.     (void)SvPOK_only(TARG);
  1616.     XPUSHs(TARG);
  1617.     RETURN;
  1618. }
  1619.  
  1620. PP(pp_crypt)
  1621. {
  1622.     dSP; dTARGET; dPOPTOPssrl;
  1623. #ifdef HAS_CRYPT
  1624.     char *tmps = SvPV(left, na);
  1625. #ifdef FCRYPT
  1626.     sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
  1627. #else
  1628.     sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
  1629. #endif
  1630. #else
  1631.     DIE(
  1632.       "The crypt() function is unimplemented due to excessive paranoia.");
  1633. #endif
  1634.     SETs(TARG);
  1635.     RETURN;
  1636. }
  1637.  
  1638. PP(pp_ucfirst)
  1639. {
  1640.     dSP;
  1641.     SV *sv = TOPs;
  1642.     register char *s;
  1643.  
  1644.     if (!SvPADTMP(sv)) {
  1645.     dTARGET;
  1646.     sv_setsv(TARG, sv);
  1647.     sv = TARG;
  1648.     SETs(sv);
  1649.     }
  1650.     s = SvPV_force(sv, na);
  1651.     if (isLOWER(*s))
  1652.     *s = toUPPER(*s);
  1653.  
  1654.     RETURN;
  1655. }
  1656.  
  1657. PP(pp_lcfirst)
  1658. {
  1659.     dSP;
  1660.     SV *sv = TOPs;
  1661.     register char *s;
  1662.  
  1663.     if (!SvPADTMP(sv)) {
  1664.     dTARGET;
  1665.     sv_setsv(TARG, sv);
  1666.     sv = TARG;
  1667.     SETs(sv);
  1668.     }
  1669.     s = SvPV_force(sv, na);
  1670.     if (isUPPER(*s))
  1671.     *s = toLOWER(*s);
  1672.  
  1673.     SETs(sv);
  1674.     RETURN;
  1675. }
  1676.  
  1677. PP(pp_uc)
  1678. {
  1679.     dSP;
  1680.     SV *sv = TOPs;
  1681.     register char *s;
  1682.     register char *send;
  1683.     STRLEN len;
  1684.  
  1685.     if (!SvPADTMP(sv)) {
  1686.     dTARGET;
  1687.     sv_setsv(TARG, sv);
  1688.     sv = TARG;
  1689.     SETs(sv);
  1690.     }
  1691.     s = SvPV_force(sv, len);
  1692.     send = s + len;
  1693.     while (s < send) {
  1694.     if (isLOWER(*s))
  1695.         *s = toUPPER(*s);
  1696.     s++;
  1697.     }
  1698.     RETURN;
  1699. }
  1700.  
  1701. PP(pp_lc)
  1702. {
  1703.     dSP;
  1704.     SV *sv = TOPs;
  1705.     register char *s;
  1706.     register char *send;
  1707.     STRLEN len;
  1708.  
  1709.     if (!SvPADTMP(sv)) {
  1710.     dTARGET;
  1711.     sv_setsv(TARG, sv);
  1712.     sv = TARG;
  1713.     SETs(sv);
  1714.     }
  1715.     s = SvPV_force(sv, len);
  1716.     send = s + len;
  1717.     while (s < send) {
  1718.     if (isUPPER(*s))
  1719.         *s = toLOWER(*s);
  1720.     s++;
  1721.     }
  1722.     RETURN;
  1723. }
  1724.  
  1725. PP(pp_quotemeta)
  1726. {
  1727.     dSP; dTARGET;
  1728.     SV *sv = TOPs;
  1729.     STRLEN len;
  1730.     register char *s = SvPV(sv,len);
  1731.     register char *d;
  1732.  
  1733.     if (len) {
  1734.     (void)SvUPGRADE(TARG, SVt_PV);
  1735.     SvGROW(TARG, len * 2);
  1736.     d = SvPVX(TARG);
  1737.     while (len--) {
  1738.         if (!isALNUM(*s))
  1739.         *d++ = '\\';
  1740.         *d++ = *s++;
  1741.     }
  1742.     *d = '\0';
  1743.     SvCUR_set(TARG, d - SvPVX(TARG));
  1744.     (void)SvPOK_only(TARG);
  1745.     }
  1746.     else
  1747.     sv_setpvn(TARG, s, len);
  1748.     SETs(TARG);
  1749.     RETURN;
  1750. }
  1751.  
  1752. /* Arrays. */
  1753.  
  1754. PP(pp_aslice)
  1755. {
  1756.     dSP; dMARK; dORIGMARK;
  1757.     register SV** svp;
  1758.     register AV* av = (AV*)POPs;
  1759.     register I32 lval = op->op_flags & OPf_MOD;
  1760.  
  1761.     if (SvTYPE(av) == SVt_PVAV) {
  1762.     while (++MARK <= SP) {
  1763.         I32 elem = SvIVx(*MARK);
  1764.  
  1765.         svp = av_fetch(av, elem, lval);
  1766.         if (lval) {
  1767.         if (!svp || *svp == &sv_undef)
  1768.             DIE(no_aelem, elem);
  1769.         if (op->op_private & OPpLVAL_INTRO)
  1770.             save_svref(svp);
  1771.         }
  1772.         *MARK = svp ? *svp : &sv_undef;
  1773.     }
  1774.     }
  1775.     else if (GIMME != G_ARRAY) {
  1776.     MARK = ORIGMARK;
  1777.     *++MARK = *SP;
  1778.     SP = MARK;
  1779.     }
  1780.     RETURN;
  1781. }
  1782.  
  1783. /* Associative arrays. */
  1784.  
  1785. PP(pp_each)
  1786. {
  1787.     dSP; dTARGET;
  1788.     HV *hash = (HV*)POPs;
  1789.     HE *entry = hv_iternext(hash);
  1790.     I32 i;
  1791.     char *tmps;
  1792.  
  1793.     EXTEND(SP, 2);
  1794.     if (entry) {
  1795.     tmps = hv_iterkey(entry, &i);
  1796.     if (!i)
  1797.         tmps = "";
  1798.     PUSHs(sv_2mortal(newSVpv(tmps, i)));
  1799.     if (GIMME == G_ARRAY) {
  1800.         sv_setsv(TARG, hv_iterval(hash, entry));
  1801.         PUSHs(TARG);
  1802.     }
  1803.     }
  1804.     else if (GIMME == G_SCALAR)
  1805.     RETPUSHUNDEF;
  1806.  
  1807.     RETURN;
  1808. }
  1809.  
  1810. PP(pp_values)
  1811. {
  1812.     return do_kv(ARGS);
  1813. }
  1814.  
  1815. PP(pp_keys)
  1816. {
  1817.     return do_kv(ARGS);
  1818. }
  1819.  
  1820. PP(pp_delete)
  1821. {
  1822.     dSP;
  1823.     SV *sv;
  1824.     SV *tmpsv = POPs;
  1825.     HV *hv = (HV*)POPs;
  1826.     char *tmps;
  1827.     STRLEN len;
  1828.     if (SvTYPE(hv) != SVt_PVHV) {
  1829.     DIE("Not a HASH reference");
  1830.     }
  1831.     tmps = SvPV(tmpsv, len);
  1832.     sv = hv_delete(hv, tmps, len);
  1833.     if (!sv)
  1834.     RETPUSHUNDEF;
  1835.     PUSHs(sv);
  1836.     RETURN;
  1837. }
  1838.  
  1839. PP(pp_exists)
  1840. {
  1841.     dSP;
  1842.     SV *tmpsv = POPs;
  1843.     HV *hv = (HV*)POPs;
  1844.     char *tmps;
  1845.     STRLEN len;
  1846.     if (SvTYPE(hv) != SVt_PVHV) {
  1847.     DIE("Not a HASH reference");
  1848.     }
  1849.     tmps = SvPV(tmpsv, len);
  1850.     if (hv_exists(hv, tmps, len))
  1851.     RETPUSHYES;
  1852.     RETPUSHNO;
  1853. }
  1854.  
  1855. PP(pp_hslice)
  1856. {
  1857.     dSP; dMARK; dORIGMARK;
  1858.     register SV **svp;
  1859.     register HV *hv = (HV*)POPs;
  1860.     register I32 lval = op->op_flags & OPf_MOD;
  1861.  
  1862.     if (SvTYPE(hv) == SVt_PVHV) {
  1863.     while (++MARK <= SP) {
  1864.         STRLEN keylen;
  1865.         char *key = SvPV(*MARK, keylen);
  1866.  
  1867.         svp = hv_fetch(hv, key, keylen, lval);
  1868.         if (lval) {
  1869.         if (!svp || *svp == &sv_undef)
  1870.             DIE(no_helem, key);
  1871.         if (op->op_private & OPpLVAL_INTRO)
  1872.             save_svref(svp);
  1873.         }
  1874.         *MARK = svp ? *svp : &sv_undef;
  1875.     }
  1876.     }
  1877.     if (GIMME != G_ARRAY) {
  1878.     MARK = ORIGMARK;
  1879.     *++MARK = *SP;
  1880.     SP = MARK;
  1881.     }
  1882.     RETURN;
  1883. }
  1884.  
  1885. /* List operators. */
  1886.  
  1887. PP(pp_list)
  1888. {
  1889.     dSP; dMARK;
  1890.     if (GIMME != G_ARRAY) {
  1891.     if (++MARK <= SP)
  1892.         *MARK = *SP;        /* unwanted list, return last item */
  1893.     else
  1894.         *MARK = &sv_undef;
  1895.     SP = MARK;
  1896.     }
  1897.     RETURN;
  1898. }
  1899.  
  1900. PP(pp_lslice)
  1901. {
  1902.     dSP;
  1903.     SV **lastrelem = stack_sp;
  1904.     SV **lastlelem = stack_base + POPMARK;
  1905.     SV **firstlelem = stack_base + POPMARK + 1;
  1906.     register SV **firstrelem = lastlelem + 1;
  1907.     I32 arybase = curcop->cop_arybase;
  1908.  
  1909.     register I32 max = lastrelem - lastlelem;
  1910.     register SV **lelem;
  1911.     register I32 ix;
  1912.  
  1913.     if (GIMME != G_ARRAY) {
  1914.     ix = SvIVx(*lastlelem) - arybase;
  1915.     if (ix < 0 || ix >= max)
  1916.         *firstlelem = &sv_undef;
  1917.     else
  1918.         *firstlelem = firstrelem[ix];
  1919.     SP = firstlelem;
  1920.     RETURN;
  1921.     }
  1922.  
  1923.     if (max == 0) {
  1924.     SP = firstlelem - 1;
  1925.     RETURN;
  1926.     }
  1927.  
  1928.     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
  1929.     ix = SvIVx(*lelem) - arybase;
  1930.     if (ix < 0) {
  1931.         ix += max;
  1932.         if (ix < 0)
  1933.         *lelem = &sv_undef;
  1934.         else if (!(*lelem = firstrelem[ix]))
  1935.         *lelem = &sv_undef;
  1936.     }
  1937.     else if (ix >= max || !(*lelem = firstrelem[ix]))
  1938.         *lelem = &sv_undef;
  1939.     }
  1940.     SP = lastlelem;
  1941.     RETURN;
  1942. }
  1943.  
  1944. PP(pp_anonlist)
  1945. {
  1946.     dSP; dMARK;
  1947.     I32 items = SP - MARK;
  1948.     SP = MARK;
  1949.     XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
  1950.     RETURN;
  1951. }
  1952.  
  1953. PP(pp_anonhash)
  1954. {
  1955.     dSP; dMARK; dORIGMARK;
  1956.     STRLEN len;
  1957.     HV* hv = (HV*)sv_2mortal((SV*)newHV());
  1958.  
  1959.     while (MARK < SP) {
  1960.     SV* key = *++MARK;
  1961.     char *tmps;
  1962.     SV *val = NEWSV(46, 0);
  1963.     if (MARK < SP)
  1964.         sv_setsv(val, *++MARK);
  1965.     else
  1966.         warn("Odd number of elements in hash list");
  1967.     tmps = SvPV(key,len);
  1968.     (void)hv_store(hv,tmps,len,val,0);
  1969.     }
  1970.     SP = ORIGMARK;
  1971.     XPUSHs((SV*)hv);
  1972.     RETURN;
  1973. }
  1974.  
  1975. PP(pp_splice)
  1976. {
  1977.     dSP; dMARK; dORIGMARK;
  1978.     register AV *ary = (AV*)*++MARK;
  1979.     register SV **src;
  1980.     register SV **dst;
  1981.     register I32 i;
  1982.     register I32 offset;
  1983.     register I32 length;
  1984.     I32 newlen;
  1985.     I32 after;
  1986.     I32 diff;
  1987.     SV **tmparyval = 0;
  1988.  
  1989.     SP++;
  1990.  
  1991.     if (++MARK < SP) {
  1992.     offset = SvIVx(*MARK);
  1993.     if (offset < 0)
  1994.         offset += AvFILL(ary) + 1;
  1995.     else
  1996.         offset -= curcop->cop_arybase;
  1997.     if (++MARK < SP) {
  1998.         length = SvIVx(*MARK++);
  1999.         if (length < 0)
  2000.         length = 0;
  2001.     }
  2002.     else
  2003.         length = AvMAX(ary) + 1;        /* close enough to infinity */
  2004.     }
  2005.     else {
  2006.     offset = 0;
  2007.     length = AvMAX(ary) + 1;
  2008.     }
  2009.     if (offset < 0) {
  2010.     length += offset;
  2011.     offset = 0;
  2012.     if (length < 0)
  2013.         length = 0;
  2014.     }
  2015.     if (offset > AvFILL(ary) + 1)
  2016.     offset = AvFILL(ary) + 1;
  2017.     after = AvFILL(ary) + 1 - (offset + length);
  2018.     if (after < 0) {                /* not that much array */
  2019.     length += after;            /* offset+length now in array */
  2020.     after = 0;
  2021.     if (!AvALLOC(ary))
  2022.         av_extend(ary, 0);
  2023.     }
  2024.  
  2025.     /* At this point, MARK .. SP-1 is our new LIST */
  2026.  
  2027.     newlen = SP - MARK;
  2028.     diff = newlen - length;
  2029.  
  2030.     if (diff < 0) {                /* shrinking the area */
  2031.     if (newlen) {
  2032.         New(451, tmparyval, newlen, SV*);    /* so remember insertion */
  2033.         Copy(MARK, tmparyval, newlen, SV*);
  2034.     }
  2035.  
  2036.     MARK = ORIGMARK + 1;
  2037.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2038.         MEXTEND(MARK, length);
  2039.         Copy(AvARRAY(ary)+offset, MARK, length, SV*);
  2040.         if (AvREAL(ary)) {
  2041.         for (i = length, dst = MARK; i; i--)
  2042.             sv_2mortal(*dst++);    /* free them eventualy */
  2043.         }
  2044.         MARK += length - 1;
  2045.     }
  2046.     else {
  2047.         *MARK = AvARRAY(ary)[offset+length-1];
  2048.         if (AvREAL(ary)) {
  2049.         sv_2mortal(*MARK);
  2050.         for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
  2051.             SvREFCNT_dec(*dst++);    /* free them now */
  2052.         }
  2053.     }
  2054.     AvFILL(ary) += diff;
  2055.  
  2056.     /* pull up or down? */
  2057.  
  2058.     if (offset < after) {            /* easier to pull up */
  2059.         if (offset) {            /* esp. if nothing to pull */
  2060.         src = &AvARRAY(ary)[offset-1];
  2061.         dst = src - diff;        /* diff is negative */
  2062.         for (i = offset; i > 0; i--)    /* can't trust Copy */
  2063.             *dst-- = *src--;
  2064.         }
  2065.         dst = AvARRAY(ary);
  2066.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
  2067.         AvMAX(ary) += diff;
  2068.     }
  2069.     else {
  2070.         if (after) {            /* anything to pull down? */
  2071.         src = AvARRAY(ary) + offset + length;
  2072.         dst = src + diff;        /* diff is negative */
  2073.         Move(src, dst, after, SV*);
  2074.         }
  2075.         dst = &AvARRAY(ary)[AvFILL(ary)+1];
  2076.                         /* avoid later double free */
  2077.     }
  2078.     i = -diff;
  2079.     while (i)
  2080.         dst[--i] = &sv_undef;
  2081.     
  2082.     if (newlen) {
  2083.         for (src = tmparyval, dst = AvARRAY(ary) + offset;
  2084.           newlen; newlen--) {
  2085.         *dst = NEWSV(46, 0);
  2086.         sv_setsv(*dst++, *src++);
  2087.         }
  2088.         Safefree(tmparyval);
  2089.     }
  2090.     }
  2091.     else {                    /* no, expanding (or same) */
  2092.     if (length) {
  2093.         New(452, tmparyval, length, SV*);    /* so remember deletion */
  2094.         Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
  2095.     }
  2096.  
  2097.     if (diff > 0) {                /* expanding */
  2098.  
  2099.         /* push up or down? */
  2100.  
  2101.         if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
  2102.         if (offset) {
  2103.             src = AvARRAY(ary);
  2104.             dst = src - diff;
  2105.             Move(src, dst, offset, SV*);
  2106.         }
  2107.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
  2108.         AvMAX(ary) += diff;
  2109.         AvFILL(ary) += diff;
  2110.         }
  2111.         else {
  2112.         if (AvFILL(ary) + diff >= AvMAX(ary))    /* oh, well */
  2113.             av_extend(ary, AvFILL(ary) + diff);
  2114.         AvFILL(ary) += diff;
  2115.  
  2116.         if (after) {
  2117.             dst = AvARRAY(ary) + AvFILL(ary);
  2118.             src = dst - diff;
  2119.             for (i = after; i; i--) {
  2120.             *dst-- = *src--;
  2121.             }
  2122.         }
  2123.         }
  2124.     }
  2125.  
  2126.     for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
  2127.         *dst = NEWSV(46, 0);
  2128.         sv_setsv(*dst++, *src++);
  2129.     }
  2130.     MARK = ORIGMARK + 1;
  2131.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2132.         if (length) {
  2133.         Copy(tmparyval, MARK, length, SV*);
  2134.         if (AvREAL(ary)) {
  2135.             for (i = length, dst = MARK; i; i--)
  2136.             sv_2mortal(*dst++);    /* free them eventualy */
  2137.         }
  2138.         Safefree(tmparyval);
  2139.         }
  2140.         MARK += length - 1;
  2141.     }
  2142.     else if (length--) {
  2143.         *MARK = tmparyval[length];
  2144.         if (AvREAL(ary)) {
  2145.         sv_2mortal(*MARK);
  2146.         while (length-- > 0)
  2147.             SvREFCNT_dec(tmparyval[length]);
  2148.         }
  2149.         Safefree(tmparyval);
  2150.     }
  2151.     else
  2152.         *MARK = &sv_undef;
  2153.     }
  2154.     SP = MARK;
  2155.     RETURN;
  2156. }
  2157.  
  2158. PP(pp_push)
  2159. {
  2160.     dSP; dMARK; dORIGMARK; dTARGET;
  2161.     register AV *ary = (AV*)*++MARK;
  2162.     register SV *sv = &sv_undef;
  2163.  
  2164.     for (++MARK; MARK <= SP; MARK++) {
  2165.     sv = NEWSV(51, 0);
  2166.     if (*MARK)
  2167.         sv_setsv(sv, *MARK);
  2168.     av_push(ary, sv);
  2169.     }
  2170.     SP = ORIGMARK;
  2171.     PUSHi( AvFILL(ary) + 1 );
  2172.     RETURN;
  2173. }
  2174.  
  2175. PP(pp_pop)
  2176. {
  2177.     dSP;
  2178.     AV *av = (AV*)POPs;
  2179.     SV *sv = av_pop(av);
  2180.     if (sv != &sv_undef && AvREAL(av))
  2181.     (void)sv_2mortal(sv);
  2182.     PUSHs(sv);
  2183.     RETURN;
  2184. }
  2185.  
  2186. PP(pp_shift)
  2187. {
  2188.     dSP;
  2189.     AV *av = (AV*)POPs;
  2190.     SV *sv = av_shift(av);
  2191.     EXTEND(SP, 1);
  2192.     if (!sv)
  2193.     RETPUSHUNDEF;
  2194.     if (sv != &sv_undef && AvREAL(av))
  2195.     (void)sv_2mortal(sv);
  2196.     PUSHs(sv);
  2197.     RETURN;
  2198. }
  2199.  
  2200. PP(pp_unshift)
  2201. {
  2202.     dSP; dMARK; dORIGMARK; dTARGET;
  2203.     register AV *ary = (AV*)*++MARK;
  2204.     register SV *sv;
  2205.     register I32 i = 0;
  2206.  
  2207.     av_unshift(ary, SP - MARK);
  2208.     while (MARK < SP) {
  2209.     sv = NEWSV(27, 0);
  2210.     sv_setsv(sv, *++MARK);
  2211.     (void)av_store(ary, i++, sv);
  2212.     }
  2213.  
  2214.     SP = ORIGMARK;
  2215.     PUSHi( AvFILL(ary) + 1 );
  2216.     RETURN;
  2217. }
  2218.  
  2219. PP(pp_reverse)
  2220. {
  2221.     dSP; dMARK;
  2222.     register SV *tmp;
  2223.     SV **oldsp = SP;
  2224.  
  2225.     if (GIMME == G_ARRAY) {
  2226.     MARK++;
  2227.     while (MARK < SP) {
  2228.         tmp = *MARK;
  2229.         *MARK++ = *SP;
  2230.         *SP-- = tmp;
  2231.     }
  2232.     SP = oldsp;
  2233.     }
  2234.     else {
  2235.     register char *up;
  2236.     register char *down;
  2237.     register I32 tmp;
  2238.     dTARGET;
  2239.     STRLEN len;
  2240.  
  2241.     if (SP - MARK > 1)
  2242.         do_join(TARG, &sv_no, MARK, SP);
  2243.     else
  2244.         sv_setsv(TARG, *SP);
  2245.     up = SvPV_force(TARG, len);
  2246.     if (len > 1) {
  2247.         down = SvPVX(TARG) + len - 1;
  2248.         while (down > up) {
  2249.         tmp = *up;
  2250.         *up++ = *down;
  2251.         *down-- = tmp;
  2252.         }
  2253.         (void)SvPOK_only(TARG);
  2254.     }
  2255.     SP = MARK + 1;
  2256.     SETTARG;
  2257.     }
  2258.     RETURN;
  2259. }
  2260.  
  2261. /* Explosives and implosives. */
  2262.  
  2263. PP(pp_unpack)
  2264. {
  2265.     dSP;
  2266.     dPOPPOPssrl;
  2267.     SV *sv;
  2268.     STRLEN llen;
  2269.     STRLEN rlen;
  2270.     register char *pat = SvPV(left, llen);
  2271.     register char *s = SvPV(right, rlen);
  2272.     char *strend = s + rlen;
  2273.     char *strbeg = s;
  2274.     register char *patend = pat + llen;
  2275.     I32 datumtype;
  2276.     register I32 len;
  2277.     register I32 bits;
  2278.  
  2279.     /* These must not be in registers: */
  2280.     I16 ashort;
  2281.     int aint;
  2282.     I32 along;
  2283. #ifdef QUAD
  2284.     quad aquad;
  2285. #endif
  2286.     U16 aushort;
  2287.     unsigned int auint;
  2288.     U32 aulong;
  2289. #ifdef QUAD
  2290.     unsigned quad auquad;
  2291. #endif
  2292.     char *aptr;
  2293.     float afloat;
  2294.     double adouble;
  2295.     I32 checksum = 0;
  2296.     register U32 culong;
  2297.     double cdouble;
  2298.     static char* bitcount = 0;
  2299.  
  2300.     if (GIMME != G_ARRAY) {        /* arrange to do first one only */
  2301.     /*SUPPRESS 530*/
  2302.     for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
  2303.     if (strchr("aAbBhH", *patend) || *pat == '%') {
  2304.         patend++;
  2305.         while (isDIGIT(*patend) || *patend == '*')
  2306.         patend++;
  2307.     }
  2308.     else
  2309.         patend++;
  2310.     }
  2311.     while (pat < patend) {
  2312.       reparse:
  2313.     datumtype = *pat++;
  2314.     if (pat >= patend)
  2315.         len = 1;
  2316.     else if (*pat == '*') {
  2317.         len = strend - strbeg;    /* long enough */
  2318.         pat++;
  2319.     }
  2320.     else if (isDIGIT(*pat)) {
  2321.         len = *pat++ - '0';
  2322.         while (isDIGIT(*pat))
  2323.         len = (len * 10) + (*pat++ - '0');
  2324.     }
  2325.     else
  2326.         len = (datumtype != '@');
  2327.     switch(datumtype) {
  2328.     default:
  2329.         break;
  2330.     case '%':
  2331.         if (len == 1 && pat[-1] != '1')
  2332.         len = 16;
  2333.         checksum = len;
  2334.         culong = 0;
  2335.         cdouble = 0;
  2336.         if (pat < patend)
  2337.         goto reparse;
  2338.         break;
  2339.     case '@':
  2340.         if (len > strend - strbeg)
  2341.         DIE("@ outside of string");
  2342.         s = strbeg + len;
  2343.         break;
  2344.     case 'X':
  2345.         if (len > s - strbeg)
  2346.         DIE("X outside of string");
  2347.         s -= len;
  2348.         break;
  2349.     case 'x':
  2350.         if (len > strend - s)
  2351.         DIE("x outside of string");
  2352.         s += len;
  2353.         break;
  2354.     case 'A':
  2355.     case 'a':
  2356.         if (len > strend - s)
  2357.         len = strend - s;
  2358.         if (checksum)
  2359.         goto uchar_checksum;
  2360.         sv = NEWSV(35, len);
  2361.         sv_setpvn(sv, s, len);
  2362.         s += len;
  2363.         if (datumtype == 'A') {
  2364.         aptr = s;    /* borrow register */
  2365.         s = SvPVX(sv) + len - 1;
  2366.         while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
  2367.             s--;
  2368.         *++s = '\0';
  2369.         SvCUR_set(sv, s - SvPVX(sv));
  2370.         s = aptr;    /* unborrow register */
  2371.         }
  2372.         XPUSHs(sv_2mortal(sv));
  2373.         break;
  2374.     case 'B':
  2375.     case 'b':
  2376.         if (pat[-1] == '*' || len > (strend - s) * 8)
  2377.         len = (strend - s) * 8;
  2378.         if (checksum) {
  2379.         if (!bitcount) {
  2380.             Newz(601, bitcount, 256, char);
  2381.             for (bits = 1; bits < 256; bits++) {
  2382.             if (bits & 1)    bitcount[bits]++;
  2383.             if (bits & 2)    bitcount[bits]++;
  2384.             if (bits & 4)    bitcount[bits]++;
  2385.             if (bits & 8)    bitcount[bits]++;
  2386.             if (bits & 16)    bitcount[bits]++;
  2387.             if (bits & 32)    bitcount[bits]++;
  2388.             if (bits & 64)    bitcount[bits]++;
  2389.             if (bits & 128)    bitcount[bits]++;
  2390.             }
  2391.         }
  2392.         while (len >= 8) {
  2393.             culong += bitcount[*(unsigned char*)s++];
  2394.             len -= 8;
  2395.         }
  2396.         if (len) {
  2397.             bits = *s;
  2398.             if (datumtype == 'b') {
  2399.             while (len-- > 0) {
  2400.                 if (bits & 1) culong++;
  2401.                 bits >>= 1;
  2402.             }
  2403.             }
  2404.             else {
  2405.             while (len-- > 0) {
  2406.                 if (bits & 128) culong++;
  2407.                 bits <<= 1;
  2408.             }
  2409.             }
  2410.         }
  2411.         break;
  2412.         }
  2413.         sv = NEWSV(35, len + 1);
  2414.         SvCUR_set(sv, len);
  2415.         SvPOK_on(sv);
  2416.         aptr = pat;            /* borrow register */
  2417.         pat = SvPVX(sv);
  2418.         if (datumtype == 'b') {
  2419.         aint = len;
  2420.         for (len = 0; len < aint; len++) {
  2421.             if (len & 7)        /*SUPPRESS 595*/
  2422.             bits >>= 1;
  2423.             else
  2424.             bits = *s++;
  2425.             *pat++ = '0' + (bits & 1);
  2426.         }
  2427.         }
  2428.         else {
  2429.         aint = len;
  2430.         for (len = 0; len < aint; len++) {
  2431.             if (len & 7)
  2432.             bits <<= 1;
  2433.             else
  2434.             bits = *s++;
  2435.             *pat++ = '0' + ((bits & 128) != 0);
  2436.         }
  2437.         }
  2438.         *pat = '\0';
  2439.         pat = aptr;            /* unborrow register */
  2440.         XPUSHs(sv_2mortal(sv));
  2441.         break;
  2442.     case 'H':
  2443.     case 'h':
  2444.         if (pat[-1] == '*' || len > (strend - s) * 2)
  2445.         len = (strend - s) * 2;
  2446.         sv = NEWSV(35, len + 1);
  2447.         SvCUR_set(sv, len);
  2448.         SvPOK_on(sv);
  2449.         aptr = pat;            /* borrow register */
  2450.         pat = SvPVX(sv);
  2451.         if (datumtype == 'h') {
  2452.         aint = len;
  2453.         for (len = 0; len < aint; len++) {
  2454.             if (len & 1)
  2455.             bits >>= 4;
  2456.             else
  2457.             bits = *s++;
  2458.             *pat++ = hexdigit[bits & 15];
  2459.         }
  2460.         }
  2461.         else {
  2462.         aint = len;
  2463.         for (len = 0; len < aint; len++) {
  2464.             if (len & 1)
  2465.             bits <<= 4;
  2466.             else
  2467.             bits = *s++;
  2468.             *pat++ = hexdigit[(bits >> 4) & 15];
  2469.         }
  2470.         }
  2471.         *pat = '\0';
  2472.         pat = aptr;            /* unborrow register */
  2473.         XPUSHs(sv_2mortal(sv));
  2474.         break;
  2475.     case 'c':
  2476.         if (len > strend - s)
  2477.         len = strend - s;
  2478.         if (checksum) {
  2479.         while (len-- > 0) {
  2480.             aint = *s++;
  2481.             if (aint >= 128)    /* fake up signed chars */
  2482.             aint -= 256;
  2483.             culong += aint;
  2484.         }
  2485.         }
  2486.         else {
  2487.         EXTEND(SP, len);
  2488.         while (len-- > 0) {
  2489.             aint = *s++;
  2490.             if (aint >= 128)    /* fake up signed chars */
  2491.             aint -= 256;
  2492.             sv = NEWSV(36, 0);
  2493.             sv_setiv(sv, (I32)aint);
  2494.             PUSHs(sv_2mortal(sv));
  2495.         }
  2496.         }
  2497.         break;
  2498.     case 'C':
  2499.         if (len > strend - s)
  2500.         len = strend - s;
  2501.         if (checksum) {
  2502.           uchar_checksum:
  2503.         while (len-- > 0) {
  2504.             auint = *s++ & 255;
  2505.             culong += auint;
  2506.         }
  2507.         }
  2508.         else {
  2509.         EXTEND(SP, len);
  2510.         while (len-- > 0) {
  2511.             auint = *s++ & 255;
  2512.             sv = NEWSV(37, 0);
  2513.             sv_setiv(sv, (I32)auint);
  2514.             PUSHs(sv_2mortal(sv));
  2515.         }
  2516.         }
  2517.         break;
  2518.     case 's':
  2519.         along = (strend - s) / sizeof(I16);
  2520.         if (len > along)
  2521.         len = along;
  2522.         if (checksum) {
  2523.         while (len-- > 0) {
  2524.             Copy(s, &ashort, 1, I16);
  2525.             s += sizeof(I16);
  2526.             culong += ashort;
  2527.         }
  2528.         }
  2529.         else {
  2530.         EXTEND(SP, len);
  2531.         while (len-- > 0) {
  2532.             Copy(s, &ashort, 1, I16);
  2533.             s += sizeof(I16);
  2534.             sv = NEWSV(38, 0);
  2535.             sv_setiv(sv, (I32)ashort);
  2536.             PUSHs(sv_2mortal(sv));
  2537.         }
  2538.         }
  2539.         break;
  2540.     case 'v':
  2541.     case 'n':
  2542.     case 'S':
  2543.         along = (strend - s) / sizeof(U16);
  2544.         if (len > along)
  2545.         len = along;
  2546.         if (checksum) {
  2547.         while (len-- > 0) {
  2548.             Copy(s, &aushort, 1, U16);
  2549.             s += sizeof(U16);
  2550. #ifdef HAS_NTOHS
  2551.             if (datumtype == 'n')
  2552.             aushort = ntohs(aushort);
  2553. #endif
  2554. #ifdef HAS_VTOHS
  2555.             if (datumtype == 'v')
  2556.             aushort = vtohs(aushort);
  2557. #endif
  2558.             culong += aushort;
  2559.         }
  2560.         }
  2561.         else {
  2562.         EXTEND(SP, len);
  2563.         while (len-- > 0) {
  2564.             Copy(s, &aushort, 1, U16);
  2565.             s += sizeof(U16);
  2566.             sv = NEWSV(39, 0);
  2567. #ifdef HAS_NTOHS
  2568.             if (datumtype == 'n')
  2569.             aushort = ntohs(aushort);
  2570. #endif
  2571. #ifdef HAS_VTOHS
  2572.             if (datumtype == 'v')
  2573.             aushort = vtohs(aushort);
  2574. #endif
  2575.             sv_setiv(sv, (I32)aushort);
  2576.             PUSHs(sv_2mortal(sv));
  2577.         }
  2578.         }
  2579.         break;
  2580.     case 'i':
  2581.         along = (strend - s) / sizeof(int);
  2582.         if (len > along)
  2583.         len = along;
  2584.         if (checksum) {
  2585.         while (len-- > 0) {
  2586.             Copy(s, &aint, 1, int);
  2587.             s += sizeof(int);
  2588.             if (checksum > 32)
  2589.             cdouble += (double)aint;
  2590.             else
  2591.             culong += aint;
  2592.         }
  2593.         }
  2594.         else {
  2595.         EXTEND(SP, len);
  2596.         while (len-- > 0) {
  2597.             Copy(s, &aint, 1, int);
  2598.             s += sizeof(int);
  2599.             sv = NEWSV(40, 0);
  2600.             sv_setiv(sv, (I32)aint);
  2601.             PUSHs(sv_2mortal(sv));
  2602.         }
  2603.         }
  2604.         break;
  2605.     case 'I':
  2606.         along = (strend - s) / sizeof(unsigned int);
  2607.         if (len > along)
  2608.         len = along;
  2609.         if (checksum) {
  2610.         while (len-- > 0) {
  2611.             Copy(s, &auint, 1, unsigned int);
  2612.             s += sizeof(unsigned int);
  2613.             if (checksum > 32)
  2614.             cdouble += (double)auint;
  2615.             else
  2616.             culong += auint;
  2617.         }
  2618.         }
  2619.         else {
  2620.         EXTEND(SP, len);
  2621.         while (len-- > 0) {
  2622.             Copy(s, &auint, 1, unsigned int);
  2623.             s += sizeof(unsigned int);
  2624.             sv = NEWSV(41, 0);
  2625.             sv_setiv(sv, (I32)auint);
  2626.             PUSHs(sv_2mortal(sv));
  2627.         }
  2628.         }
  2629.         break;
  2630.     case 'l':
  2631.         along = (strend - s) / sizeof(I32);
  2632.         if (len > along)
  2633.         len = along;
  2634.         if (checksum) {
  2635.         while (len-- > 0) {
  2636.             Copy(s, &along, 1, I32);
  2637.             s += sizeof(I32);
  2638.             if (checksum > 32)
  2639.             cdouble += (double)along;
  2640.             else
  2641.             culong += along;
  2642.         }
  2643.         }
  2644.         else {
  2645.         EXTEND(SP, len);
  2646.         while (len-- > 0) {
  2647.             Copy(s, &along, 1, I32);
  2648.             s += sizeof(I32);
  2649.             sv = NEWSV(42, 0);
  2650.             sv_setiv(sv, (I32)along);
  2651.             PUSHs(sv_2mortal(sv));
  2652.         }
  2653.         }
  2654.         break;
  2655.     case 'V':
  2656.     case 'N':
  2657.     case 'L':
  2658.         along = (strend - s) / sizeof(U32);
  2659.         if (len > along)
  2660.         len = along;
  2661.         if (checksum) {
  2662.         while (len-- > 0) {
  2663.             Copy(s, &aulong, 1, U32);
  2664.             s += sizeof(U32);
  2665. #ifdef HAS_NTOHL
  2666.             if (datumtype == 'N')
  2667.             aulong = ntohl(aulong);
  2668. #endif
  2669. #ifdef HAS_VTOHL
  2670.             if (datumtype == 'V')
  2671.             aulong = vtohl(aulong);
  2672. #endif
  2673.             if (checksum > 32)
  2674.             cdouble += (double)aulong;
  2675.             else
  2676.             culong += aulong;
  2677.         }
  2678.         }
  2679.         else {
  2680.         EXTEND(SP, len);
  2681.         while (len-- > 0) {
  2682.             Copy(s, &aulong, 1, U32);
  2683.             s += sizeof(U32);
  2684.             sv = NEWSV(43, 0);
  2685. #ifdef HAS_NTOHL
  2686.             if (datumtype == 'N')
  2687.             aulong = ntohl(aulong);
  2688. #endif
  2689. #ifdef HAS_VTOHL
  2690.             if (datumtype == 'V')
  2691.             aulong = vtohl(aulong);
  2692. #endif
  2693.             sv_setnv(sv, (double)aulong);
  2694.             PUSHs(sv_2mortal(sv));
  2695.         }
  2696.         }
  2697.         break;
  2698.     case 'p':
  2699.         along = (strend - s) / sizeof(char*);
  2700.         if (len > along)
  2701.         len = along;
  2702.         EXTEND(SP, len);
  2703.         while (len-- > 0) {
  2704.         if (sizeof(char*) > strend - s)
  2705.             break;
  2706.         else {
  2707.             Copy(s, &aptr, 1, char*);
  2708.             s += sizeof(char*);
  2709.         }
  2710.         sv = NEWSV(44, 0);
  2711.         if (aptr)
  2712.             sv_setpv(sv, aptr);
  2713.         PUSHs(sv_2mortal(sv));
  2714.         }
  2715.         break;
  2716.     case 'P':
  2717.         EXTEND(SP, 1);
  2718.         if (sizeof(char*) > strend - s)
  2719.         break;
  2720.         else {
  2721.         Copy(s, &aptr, 1, char*);
  2722.         s += sizeof(char*);
  2723.         }
  2724.         sv = NEWSV(44, 0);
  2725.         if (aptr)
  2726.         sv_setpvn(sv, aptr, len);
  2727.         PUSHs(sv_2mortal(sv));
  2728.         break;
  2729. #ifdef QUAD
  2730.     case 'q':
  2731.         EXTEND(SP, len);
  2732.         while (len-- > 0) {
  2733.         if (s + sizeof(quad) > strend)
  2734.             aquad = 0;
  2735.         else {
  2736.             Copy(s, &aquad, 1, quad);
  2737.             s += sizeof(quad);
  2738.         }
  2739.         sv = NEWSV(42, 0);
  2740.         sv_setiv(sv, (IV)aquad);
  2741.         PUSHs(sv_2mortal(sv));
  2742.         }
  2743.         break;
  2744.     case 'Q':
  2745.         EXTEND(SP, len);
  2746.         while (len-- > 0) {
  2747.         if (s + sizeof(unsigned quad) > strend)
  2748.             auquad = 0;
  2749.         else {
  2750.             Copy(s, &auquad, 1, unsigned quad);
  2751.             s += sizeof(unsigned quad);
  2752.         }
  2753.         sv = NEWSV(43, 0);
  2754.         sv_setiv(sv, (IV)auquad);
  2755.         PUSHs(sv_2mortal(sv));
  2756.         }
  2757.         break;
  2758. #endif
  2759.     /* float and double added gnb@melba.bby.oz.au 22/11/89 */
  2760.     case 'f':
  2761.     case 'F':
  2762.         along = (strend - s) / sizeof(float);
  2763.         if (len > along)
  2764.         len = along;
  2765.         if (checksum) {
  2766.         while (len-- > 0) {
  2767.             Copy(s, &afloat, 1, float);
  2768.             s += sizeof(float);
  2769.             cdouble += afloat;
  2770.         }
  2771.         }
  2772.         else {
  2773.         EXTEND(SP, len);
  2774.         while (len-- > 0) {
  2775.             Copy(s, &afloat, 1, float);
  2776.             s += sizeof(float);
  2777.             sv = NEWSV(47, 0);
  2778.             sv_setnv(sv, (double)afloat);
  2779.             PUSHs(sv_2mortal(sv));
  2780.         }
  2781.         }
  2782.         break;
  2783.     case 'd':
  2784.     case 'D':
  2785.         along = (strend - s) / sizeof(double);
  2786.         if (len > along)
  2787.         len = along;
  2788.         if (checksum) {
  2789.         while (len-- > 0) {
  2790.             Copy(s, &adouble, 1, double);
  2791.             s += sizeof(double);
  2792.             cdouble += adouble;
  2793.         }
  2794.         }
  2795.         else {
  2796.         EXTEND(SP, len);
  2797.         while (len-- > 0) {
  2798.             Copy(s, &adouble, 1, double);
  2799.             s += sizeof(double);
  2800.             sv = NEWSV(48, 0);
  2801.             sv_setnv(sv, (double)adouble);
  2802.             PUSHs(sv_2mortal(sv));
  2803.         }
  2804.         }
  2805.         break;
  2806.     case 'u':
  2807.         along = (strend - s) * 3 / 4;
  2808.         sv = NEWSV(42, along);
  2809.         while (s < strend && *s > ' ' && *s < 'a') {
  2810.         I32 a, b, c, d;
  2811.         char hunk[4];
  2812.  
  2813.         hunk[3] = '\0';
  2814.         len = (*s++ - ' ') & 077;
  2815.         while (len > 0) {
  2816.             if (s < strend && *s >= ' ')
  2817.             a = (*s++ - ' ') & 077;
  2818.             else
  2819.             a = 0;
  2820.             if (s < strend && *s >= ' ')
  2821.             b = (*s++ - ' ') & 077;
  2822.             else
  2823.             b = 0;
  2824.             if (s < strend && *s >= ' ')
  2825.             c = (*s++ - ' ') & 077;
  2826.             else
  2827.             c = 0;
  2828.             if (s < strend && *s >= ' ')
  2829.             d = (*s++ - ' ') & 077;
  2830.             else
  2831.             d = 0;
  2832.             hunk[0] = a << 2 | b >> 4;
  2833.             hunk[1] = b << 4 | c >> 2;
  2834.             hunk[2] = c << 6 | d;
  2835.             sv_catpvn(sv, hunk, len > 3 ? 3 : len);
  2836.             len -= 3;
  2837.         }
  2838.         if (*s == '\n')
  2839.             s++;
  2840.         else if (s[1] == '\n')        /* possible checksum byte */
  2841.             s += 2;
  2842.         }
  2843.         XPUSHs(sv_2mortal(sv));
  2844.         break;
  2845.     }
  2846.     if (checksum) {
  2847.         sv = NEWSV(42, 0);
  2848.         if (strchr("fFdD", datumtype) ||
  2849.           (checksum > 32 && strchr("iIlLN", datumtype)) ) {
  2850.         double trouble;
  2851.  
  2852.         adouble = 1.0;
  2853.         while (checksum >= 16) {
  2854.             checksum -= 16;
  2855.             adouble *= 65536.0;
  2856.         }
  2857.         while (checksum >= 4) {
  2858.             checksum -= 4;
  2859.             adouble *= 16.0;
  2860.         }
  2861.         while (checksum--)
  2862.             adouble *= 2.0;
  2863.         along = (1 << checksum) - 1;
  2864.         while (cdouble < 0.0)
  2865.             cdouble += adouble;
  2866.         cdouble = modf(cdouble / adouble, &trouble) * adouble;
  2867.         sv_setnv(sv, cdouble);
  2868.         }
  2869.         else {
  2870.         if (checksum < 32) {
  2871.             along = (1 << checksum) - 1;
  2872.             culong &= (U32)along;
  2873.         }
  2874.         sv_setnv(sv, (double)culong);
  2875.         }
  2876.         XPUSHs(sv_2mortal(sv));
  2877.         checksum = 0;
  2878.     }
  2879.     }
  2880.     RETURN;
  2881. }
  2882.  
  2883. static void
  2884. doencodes(sv, s, len)
  2885. register SV *sv;
  2886. register char *s;
  2887. register I32 len;
  2888. {
  2889.     char hunk[5];
  2890.  
  2891.     *hunk = len + ' ';
  2892.     sv_catpvn(sv, hunk, 1);
  2893.     hunk[4] = '\0';
  2894.     while (len > 0) {
  2895.     hunk[0] = ' ' + (077 & (*s >> 2));
  2896.     hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
  2897.     hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
  2898.     hunk[3] = ' ' + (077 & (s[2] & 077));
  2899.     sv_catpvn(sv, hunk, 4);
  2900.     s += 3;
  2901.     len -= 3;
  2902.     }
  2903.     for (s = SvPVX(sv); *s; s++) {
  2904.     if (*s == ' ')
  2905.         *s = '`';
  2906.     }
  2907.     sv_catpvn(sv, "\n", 1);
  2908. }
  2909.  
  2910. PP(pp_pack)
  2911. {
  2912.     dSP; dMARK; dORIGMARK; dTARGET;
  2913.     register SV *cat = TARG;
  2914.     register I32 items;
  2915.     STRLEN fromlen;
  2916.     register char *pat = SvPVx(*++MARK, fromlen);
  2917.     register char *patend = pat + fromlen;
  2918.     register I32 len;
  2919.     I32 datumtype;
  2920.     SV *fromstr;
  2921.     /*SUPPRESS 442*/
  2922.     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
  2923.     static char *space10 = "          ";
  2924.  
  2925.     /* These must not be in registers: */
  2926.     char achar;
  2927.     I16 ashort;
  2928.     int aint;
  2929.     unsigned int auint;
  2930.     I32 along;
  2931.     U32 aulong;
  2932. #ifdef QUAD
  2933.     quad aquad;
  2934.     unsigned quad auquad;
  2935. #endif
  2936.     char *aptr;
  2937.     float afloat;
  2938.     double adouble;
  2939.  
  2940.     items = SP - MARK;
  2941.     MARK++;
  2942.     sv_setpvn(cat, "", 0);
  2943.     while (pat < patend) {
  2944. #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
  2945.     datumtype = *pat++;
  2946.     if (*pat == '*') {
  2947.         len = strchr("@Xxu", datumtype) ? 0 : items;
  2948.         pat++;
  2949.     }
  2950.     else if (isDIGIT(*pat)) {
  2951.         len = *pat++ - '0';
  2952.         while (isDIGIT(*pat))
  2953.         len = (len * 10) + (*pat++ - '0');
  2954.     }
  2955.     else
  2956.         len = 1;
  2957.     switch(datumtype) {
  2958.     default:
  2959.         break;
  2960.     case '%':
  2961.         DIE("%% may only be used in unpack");
  2962.     case '@':
  2963.         len -= SvCUR(cat);
  2964.         if (len > 0)
  2965.         goto grow;
  2966.         len = -len;
  2967.         if (len > 0)
  2968.         goto shrink;
  2969.         break;
  2970.     case 'X':
  2971.       shrink:
  2972.         if (SvCUR(cat) < len)
  2973.         DIE("X outside of string");
  2974.         SvCUR(cat) -= len;
  2975.         *SvEND(cat) = '\0';
  2976.         break;
  2977.     case 'x':
  2978.       grow:
  2979.         while (len >= 10) {
  2980.         sv_catpvn(cat, null10, 10);
  2981.         len -= 10;
  2982.         }
  2983.         sv_catpvn(cat, null10, len);
  2984.         break;
  2985.     case 'A':
  2986.     case 'a':
  2987.         fromstr = NEXTFROM;
  2988.         aptr = SvPV(fromstr, fromlen);
  2989.         if (pat[-1] == '*')
  2990.         len = fromlen;
  2991.         if (fromlen > len)
  2992.         sv_catpvn(cat, aptr, len);
  2993.         else {
  2994.         sv_catpvn(cat, aptr, fromlen);
  2995.         len -= fromlen;
  2996.         if (datumtype == 'A') {
  2997.             while (len >= 10) {
  2998.             sv_catpvn(cat, space10, 10);
  2999.             len -= 10;
  3000.             }
  3001.             sv_catpvn(cat, space10, len);
  3002.         }
  3003.         else {
  3004.             while (len >= 10) {
  3005.             sv_catpvn(cat, null10, 10);
  3006.             len -= 10;
  3007.             }
  3008.             sv_catpvn(cat, null10, len);
  3009.         }
  3010.         }
  3011.         break;
  3012.     case 'B':
  3013.     case 'b':
  3014.         {
  3015.         char *savepat = pat;
  3016.         I32 saveitems;
  3017.  
  3018.         fromstr = NEXTFROM;
  3019.         saveitems = items;
  3020.         aptr = SvPV(fromstr, fromlen);
  3021.         if (pat[-1] == '*')
  3022.             len = fromlen;
  3023.         pat = aptr;
  3024.         aint = SvCUR(cat);
  3025.         SvCUR(cat) += (len+7)/8;
  3026.         SvGROW(cat, SvCUR(cat) + 1);
  3027.         aptr = SvPVX(cat) + aint;
  3028.         if (len > fromlen)
  3029.             len = fromlen;
  3030.         aint = len;
  3031.         items = 0;
  3032.         if (datumtype == 'B') {
  3033.             for (len = 0; len++ < aint;) {
  3034.             items |= *pat++ & 1;
  3035.             if (len & 7)
  3036.                 items <<= 1;
  3037.             else {
  3038.                 *aptr++ = items & 0xff;
  3039.                 items = 0;
  3040.             }
  3041.             }
  3042.         }
  3043.         else {
  3044.             for (len = 0; len++ < aint;) {
  3045.             if (*pat++ & 1)
  3046.                 items |= 128;
  3047.             if (len & 7)
  3048.                 items >>= 1;
  3049.             else {
  3050.                 *aptr++ = items & 0xff;
  3051.                 items = 0;
  3052.             }
  3053.             }
  3054.         }
  3055.         if (aint & 7) {
  3056.             if (datumtype == 'B')
  3057.             items <<= 7 - (aint & 7);
  3058.             else
  3059.             items >>= 7 - (aint & 7);
  3060.             *aptr++ = items & 0xff;
  3061.         }
  3062.         pat = SvPVX(cat) + SvCUR(cat);
  3063.         while (aptr <= pat)
  3064.             *aptr++ = '\0';
  3065.  
  3066.         pat = savepat;
  3067.         items = saveitems;
  3068.         }
  3069.         break;
  3070.     case 'H':
  3071.     case 'h':
  3072.         {
  3073.         char *savepat = pat;
  3074.         I32 saveitems;
  3075.  
  3076.         fromstr = NEXTFROM;
  3077.         saveitems = items;
  3078.         aptr = SvPV(fromstr, fromlen);
  3079.         if (pat[-1] == '*')
  3080.             len = fromlen;
  3081.         pat = aptr;
  3082.         aint = SvCUR(cat);
  3083.         SvCUR(cat) += (len+1)/2;
  3084.         SvGROW(cat, SvCUR(cat) + 1);
  3085.         aptr = SvPVX(cat) + aint;
  3086.         if (len > fromlen)
  3087.             len = fromlen;
  3088.         aint = len;
  3089.         items = 0;
  3090.         if (datumtype == 'H') {
  3091.             for (len = 0; len++ < aint;) {
  3092.             if (isALPHA(*pat))
  3093.                 items |= ((*pat++ & 15) + 9) & 15;
  3094.             else
  3095.                 items |= *pat++ & 15;
  3096.             if (len & 1)
  3097.                 items <<= 4;
  3098.             else {
  3099.                 *aptr++ = items & 0xff;
  3100.                 items = 0;
  3101.             }
  3102.             }
  3103.         }
  3104.         else {
  3105.             for (len = 0; len++ < aint;) {
  3106.             if (isALPHA(*pat))
  3107.                 items |= (((*pat++ & 15) + 9) & 15) << 4;
  3108.             else
  3109.                 items |= (*pat++ & 15) << 4;
  3110.             if (len & 1)
  3111.                 items >>= 4;
  3112.             else {
  3113.                 *aptr++ = items & 0xff;
  3114.                 items = 0;
  3115.             }
  3116.             }
  3117.         }
  3118.         if (aint & 1)
  3119.             *aptr++ = items & 0xff;
  3120.         pat = SvPVX(cat) + SvCUR(cat);
  3121.         while (aptr <= pat)
  3122.             *aptr++ = '\0';
  3123.  
  3124.         pat = savepat;
  3125.         items = saveitems;
  3126.         }
  3127.         break;
  3128.     case 'C':
  3129.     case 'c':
  3130.         while (len-- > 0) {
  3131.         fromstr = NEXTFROM;
  3132.         aint = SvIV(fromstr);
  3133.         achar = aint;
  3134.         sv_catpvn(cat, &achar, sizeof(char));
  3135.         }
  3136.         break;
  3137.     /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
  3138.     case 'f':
  3139.     case 'F':
  3140.         while (len-- > 0) {
  3141.         fromstr = NEXTFROM;
  3142.         afloat = (float)SvNV(fromstr);
  3143.         sv_catpvn(cat, (char *)&afloat, sizeof (float));
  3144.         }
  3145.         break;
  3146.     case 'd':
  3147.     case 'D':
  3148.         while (len-- > 0) {
  3149.         fromstr = NEXTFROM;
  3150.         adouble = (double)SvNV(fromstr);
  3151.         sv_catpvn(cat, (char *)&adouble, sizeof (double));
  3152.         }
  3153.         break;
  3154.     case 'n':
  3155.         while (len-- > 0) {
  3156.         fromstr = NEXTFROM;
  3157.         ashort = (I16)SvIV(fromstr);
  3158. #ifdef HAS_HTONS
  3159.         ashort = htons(ashort);
  3160. #endif
  3161.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3162.         }
  3163.         break;
  3164.     case 'v':
  3165.         while (len-- > 0) {
  3166.         fromstr = NEXTFROM;
  3167.         ashort = (I16)SvIV(fromstr);
  3168. #ifdef HAS_HTOVS
  3169.         ashort = htovs(ashort);
  3170. #endif
  3171.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3172.         }
  3173.         break;
  3174.     case 'S':
  3175.     case 's':
  3176.         while (len-- > 0) {
  3177.         fromstr = NEXTFROM;
  3178.         ashort = (I16)SvIV(fromstr);
  3179.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3180.         }
  3181.         break;
  3182.     case 'I':
  3183.         while (len-- > 0) {
  3184.         fromstr = NEXTFROM;
  3185.         auint = U_I(SvNV(fromstr));
  3186.         sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
  3187.         }
  3188.         break;
  3189.     case 'i':
  3190.         while (len-- > 0) {
  3191.         fromstr = NEXTFROM;
  3192.         aint = SvIV(fromstr);
  3193.         sv_catpvn(cat, (char*)&aint, sizeof(int));
  3194.         }
  3195.         break;
  3196.     case 'N':
  3197.         while (len-- > 0) {
  3198.         fromstr = NEXTFROM;
  3199.         aulong = U_L(SvNV(fromstr));
  3200. #ifdef HAS_HTONL
  3201.         aulong = htonl(aulong);
  3202. #endif
  3203.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3204.         }
  3205.         break;
  3206.     case 'V':
  3207.         while (len-- > 0) {
  3208.         fromstr = NEXTFROM;
  3209.         aulong = U_L(SvNV(fromstr));
  3210. #ifdef HAS_HTOVL
  3211.         aulong = htovl(aulong);
  3212. #endif
  3213.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3214.         }
  3215.         break;
  3216.     case 'L':
  3217.         while (len-- > 0) {
  3218.         fromstr = NEXTFROM;
  3219.         aulong = U_L(SvNV(fromstr));
  3220.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3221.         }
  3222.         break;
  3223.     case 'l':
  3224.         while (len-- > 0) {
  3225.         fromstr = NEXTFROM;
  3226.         along = SvIV(fromstr);
  3227.         sv_catpvn(cat, (char*)&along, sizeof(I32));
  3228.         }
  3229.         break;
  3230. #ifdef QUAD
  3231.     case 'Q':
  3232.         while (len-- > 0) {
  3233.         fromstr = NEXTFROM;
  3234.         auquad = (unsigned quad)SvIV(fromstr);
  3235.         sv_catpvn(cat, (char*)&auquad, sizeof(unsigned quad));
  3236.         }
  3237.         break;
  3238.     case 'q':
  3239.         while (len-- > 0) {
  3240.         fromstr = NEXTFROM;
  3241.         aquad = (quad)SvIV(fromstr);
  3242.         sv_catpvn(cat, (char*)&aquad, sizeof(quad));
  3243.         }
  3244.         break;
  3245. #endif /* QUAD */
  3246.     case 'P':
  3247.         len = 1;        /* assume SV is correct length */
  3248.         /* FALL THROUGH */
  3249.     case 'p':
  3250.         while (len-- > 0) {
  3251.         fromstr = NEXTFROM;
  3252.         aptr = SvPV_force(fromstr, na);    /* XXX Error if TEMP? */
  3253.         sv_catpvn(cat, (char*)&aptr, sizeof(char*));
  3254.         }
  3255.         break;
  3256.     case 'u':
  3257.         fromstr = NEXTFROM;
  3258.         aptr = SvPV(fromstr, fromlen);
  3259.         SvGROW(cat, fromlen * 4 / 3);
  3260.         if (len <= 1)
  3261.         len = 45;
  3262.         else
  3263.         len = len / 3 * 3;
  3264.         while (fromlen > 0) {
  3265.         I32 todo;
  3266.  
  3267.         if (fromlen > len)
  3268.             todo = len;
  3269.         else
  3270.             todo = fromlen;
  3271.         doencodes(cat, aptr, todo);
  3272.         fromlen -= todo;
  3273.         aptr += todo;
  3274.         }
  3275.         break;
  3276.     }
  3277.     }
  3278.     SvSETMAGIC(cat);
  3279.     SP = ORIGMARK;
  3280.     PUSHs(cat);
  3281.     RETURN;
  3282. }
  3283. #undef NEXTFROM
  3284.  
  3285. PP(pp_split)
  3286. {
  3287.     dSP; dTARG;
  3288.     AV *ary;
  3289.     register I32 limit = POPi;            /* note, negative is forever */
  3290.     SV *sv = POPs;
  3291.     STRLEN len;
  3292.     register char *s = SvPV(sv, len);
  3293.     char *strend = s + len;
  3294.     register PMOP *pm = (PMOP*)POPs;
  3295.     register SV *dstr;
  3296.     register char *m;
  3297.     I32 iters = 0;
  3298.     I32 maxiters = (strend - s) + 10;
  3299.     I32 i;
  3300.     char *orig;
  3301.     I32 origlimit = limit;
  3302.     I32 realarray = 0;
  3303.     I32 base;
  3304.     AV *oldstack = stack;
  3305.     register REGEXP *rx = pm->op_pmregexp;
  3306.     I32 gimme = GIMME;
  3307.  
  3308.     if (!pm || !s)
  3309.     DIE("panic: do_split");
  3310.     if (pm->op_pmreplroot)
  3311.     ary = GvAVn((GV*)pm->op_pmreplroot);
  3312.     else if (gimme != G_ARRAY)
  3313.     ary = GvAVn(defgv);
  3314.     else
  3315.     ary = Nullav;
  3316.     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
  3317.     realarray = 1;
  3318.     if (!AvREAL(ary)) {
  3319.         AvREAL_on(ary);
  3320.         for (i = AvFILL(ary); i >= 0; i--)
  3321.         AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
  3322.     }
  3323.     av_extend(ary,0);
  3324.     av_clear(ary);
  3325.     /* temporarily switch stacks */
  3326.     SWITCHSTACK(stack, ary);
  3327.     }
  3328.     base = SP - stack_base;
  3329.     orig = s;
  3330.     if (pm->op_pmflags & PMf_SKIPWHITE) {
  3331.     while (isSPACE(*s))
  3332.         s++;
  3333.     }
  3334.     if (!limit)
  3335.     limit = maxiters + 2;
  3336.     if (pm->op_pmflags & PMf_WHITE) {
  3337.     while (--limit) {
  3338.         /*SUPPRESS 530*/
  3339.         for (m = s; m < strend && !isSPACE(*m); m++) ;
  3340.         if (m >= strend)
  3341.         break;
  3342.         dstr = NEWSV(30, m-s);
  3343.         sv_setpvn(dstr, s, m-s);
  3344.         if (!realarray)
  3345.         sv_2mortal(dstr);
  3346.         XPUSHs(dstr);
  3347.         /*SUPPRESS 530*/
  3348.         for (s = m + 1; s < strend && isSPACE(*s); s++) ;
  3349.     }
  3350.     }
  3351.     else if (strEQ("^", rx->precomp)) {
  3352.     while (--limit) {
  3353.         /*SUPPRESS 530*/
  3354.         for (m = s; m < strend && *m != '\n'; m++) ;
  3355.         m++;
  3356.         if (m >= strend)
  3357.         break;
  3358.         dstr = NEWSV(30, m-s);
  3359.         sv_setpvn(dstr, s, m-s);
  3360.         if (!realarray)
  3361.         sv_2mortal(dstr);
  3362.         XPUSHs(dstr);
  3363.         s = m;
  3364.     }
  3365.     }
  3366.     else if (pm->op_pmshort) {
  3367.     i = SvCUR(pm->op_pmshort);
  3368.     if (i == 1) {
  3369.         I32 fold = (pm->op_pmflags & PMf_FOLD);
  3370.         i = *SvPVX(pm->op_pmshort);
  3371.         if (fold && isUPPER(i))
  3372.         i = toLOWER(i);
  3373.         while (--limit) {
  3374.         if (fold) {
  3375.             for ( m = s;
  3376.               m < strend && *m != i &&
  3377.                 (!isUPPER(*m) || toLOWER(*m) != i);
  3378.               m++)            /*SUPPRESS 530*/
  3379.             ;
  3380.         }
  3381.         else                /*SUPPRESS 530*/
  3382.             for (m = s; m < strend && *m != i; m++) ;
  3383.         if (m >= strend)
  3384.             break;
  3385.         dstr = NEWSV(30, m-s);
  3386.         sv_setpvn(dstr, s, m-s);
  3387.         if (!realarray)
  3388.             sv_2mortal(dstr);
  3389.         XPUSHs(dstr);
  3390.         s = m + 1;
  3391.         }
  3392.     }
  3393.     else {
  3394. #ifndef lint
  3395.         while (s < strend && --limit &&
  3396.           (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
  3397.             pm->op_pmshort)) )
  3398. #endif
  3399.         {
  3400.         dstr = NEWSV(31, m-s);
  3401.         sv_setpvn(dstr, s, m-s);
  3402.         if (!realarray)
  3403.             sv_2mortal(dstr);
  3404.         XPUSHs(dstr);
  3405.         s = m + i;
  3406.         }
  3407.     }
  3408.     }
  3409.     else {
  3410.     maxiters += (strend - s) * rx->nparens;
  3411.     while (s < strend && --limit &&
  3412.         regexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
  3413.         if (rx->subbase
  3414.           && rx->subbase != orig) {
  3415.         m = s;
  3416.         s = orig;
  3417.         orig = rx->subbase;
  3418.         s = orig + (m - s);
  3419.         strend = s + (strend - m);
  3420.         }
  3421.         m = rx->startp[0];
  3422.         dstr = NEWSV(32, m-s);
  3423.         sv_setpvn(dstr, s, m-s);
  3424.         if (!realarray)
  3425.         sv_2mortal(dstr);
  3426.         XPUSHs(dstr);
  3427.         if (rx->nparens) {
  3428.         for (i = 1; i <= rx->nparens; i++) {
  3429.             s = rx->startp[i];
  3430.             m = rx->endp[i];
  3431.             dstr = NEWSV(33, m-s);
  3432.             sv_setpvn(dstr, s, m-s);
  3433.             if (!realarray)
  3434.             sv_2mortal(dstr);
  3435.             XPUSHs(dstr);
  3436.         }
  3437.         }
  3438.         s = rx->endp[0];
  3439.     }
  3440.     }
  3441.     iters = (SP - stack_base) - base;
  3442.     if (iters > maxiters)
  3443.     DIE("Split loop");
  3444.     
  3445.     /* keep field after final delim? */
  3446.     if (s < strend || (iters && origlimit)) {
  3447.     dstr = NEWSV(34, strend-s);
  3448.     sv_setpvn(dstr, s, strend-s);
  3449.     if (!realarray)
  3450.         sv_2mortal(dstr);
  3451.     XPUSHs(dstr);
  3452.     iters++;
  3453.     }
  3454.     else if (!origlimit) {
  3455.     while (iters > 0 && SvCUR(TOPs) == 0)
  3456.         iters--, SP--;
  3457.     }
  3458.     if (realarray) {
  3459.     SWITCHSTACK(ary, oldstack);
  3460.     if (gimme == G_ARRAY) {
  3461.         EXTEND(SP, iters);
  3462.         Copy(AvARRAY(ary), SP + 1, iters, SV*);
  3463.         SP += iters;
  3464.         RETURN;
  3465.     }
  3466.     }
  3467.     else {
  3468.     if (gimme == G_ARRAY)
  3469.         RETURN;
  3470.     }
  3471.     if (iters || !pm->op_pmreplroot) {
  3472.     GETTARGET;
  3473.     PUSHi(iters);
  3474.     RETURN;
  3475.     }
  3476.     RETPUSHUNDEF;
  3477. }
  3478.  
  3479.